From 2974cf3a7ff3f1b0771e3948c6198d4dbbe1cd10 Mon Sep 17 00:00:00 2001 From: Felix Goudreault Date: Wed, 5 Jun 2019 17:07:36 +0100 Subject: [PATCH 01/95] Created subroutine to detect xml formatted files - For dynamical mattrices and interatomic forces files. - The xml format is detected by checking if an '.xml' file exists. If not an error is raised. If both file (unformatted and formatted) exists. An error is also raised. --- EPW/src/readmat_shuffle2.f90 | 98 ++++++++++++++++++++++++++++-------- 1 file changed, 76 insertions(+), 22 deletions(-) diff --git a/EPW/src/readmat_shuffle2.f90 b/EPW/src/readmat_shuffle2.f90 index 4393474e05..9da3629e7a 100644 --- a/EPW/src/readmat_shuffle2.f90 +++ b/EPW/src/readmat_shuffle2.f90 @@ -11,7 +11,7 @@ subroutine readmat_shuffle2 ( iq_irr, nqc_irr, nq, iq_first, sxq, imq, isq,& invs, s, irt, rtau) !----------------------------------------------------------------------- !! - !! read dynamical matrix for the q points + !! read dynamical matrix for the q points, either in plain text or xml. !! iq_first, iq_first+1, ... iq_first+nq-1 !! !----------------------------------------------------------------------- @@ -25,7 +25,7 @@ subroutine readmat_shuffle2 ( iq_irr, nqc_irr, nq, iq_first, sxq, imq, isq,& USE modes, ONLY : nmodes USE control_flags, ONLY : iverbosity USE phcom, ONLY : nq1, nq2, nq3 - USE noncollin_module, ONLY : noncolin, nspin_mag + USE noncollin_module, ONLY : nspin_mag USE io_dyn_mat2, ONLY : read_dyn_mat_param, read_dyn_mat_header,& read_dyn_mat USE io_global, ONLY : ionode, stdout @@ -89,7 +89,7 @@ subroutine readmat_shuffle2 ( iq_irr, nqc_irr, nq, iq_first, sxq, imq, isq,& CHARACTER(len=3) :: atm, filelab CHARACTER(len=80) :: line CHARACTER(len=256) :: tempfile - LOGICAL :: found, lrigid, lraman, nog + LOGICAL :: found, lrigid, lraman, nog, is_xml_file INTEGER :: ntyp_, nat_, ibrav_, ityp_, ios, iq, jq, & nt, na, nb, naa, nbb, nu, mu, i, j, ipol,jpol INTEGER, parameter :: ntypx = 10 @@ -117,9 +117,21 @@ subroutine readmat_shuffle2 ( iq_irr, nqc_irr, nq, iq_first, sxq, imq, isq,& ! !DBSP ! SP: If noncolin, the dynamical matrix are printed in xml format by QE - IF (noncolin) THEN - CALL set_ndnmbr ( 0, iq_irr, 1, nqc_irr, filelab) - tempfile = trim(dvscf_dir) // trim(prefix) // '.dyn_q' // filelab + ! FG: Not anymore (since v6.4?) xml files are produced only if user asks for + ! it. Thus one cannot assume anymore files are xml based on noncolin. + + ! the call to set_ndnmbr is just a trick to get quickly + ! a file label by exploiting an existing subroutine + ! (if you look at the sub you will find that the original + ! purpose was for pools and nodes) + ! + CALL set_ndnmbr ( 0, iq_irr, 1, nqc_irr, filelab) + tempfile = trim(dvscf_dir) // trim(prefix) // '.dyn_q' // trim(filelab) + ! the following function will check either or not the file is formatted in + ! xml. If no file is found, an error is raised + call check_is_xml_file(tempfile, is_xml_file) + + IF (is_xml_file) THEN CALL read_dyn_mat_param(tempfile,ntyp,nat) ALLOCATE (m_loc(3,nat)) ALLOCATE (dchi_dtau(3,3,3,nat) ) @@ -223,17 +235,8 @@ subroutine readmat_shuffle2 ( iq_irr, nqc_irr, nq, iq_first, sxq, imq, isq,& ! ENDDO ! iq = 1, mq ! - ELSE ! noncolin + ELSE ! not a xml file !END - ! - ! the call to set_ndnmbr is just a trick to get quickly - ! a file label by exploiting an existing subroutine - ! (if you look at the sub you will find that the original - ! purpose was for pools and nodes) - ! - CALL set_ndnmbr ( 0, iq_irr, 1, nqc_irr, filelab) - tempfile = trim(dvscf_dir) // trim(prefix) // '.dyn_q' // filelab - ! open (unit = iudyn, file = tempfile, status = 'old', iostat = ios) IF (ios /=0) call errore ('readmat_shuffle2', 'opening file'//tempfile, abs (ios) ) ! @@ -638,7 +641,7 @@ SUBROUTINE read_ifc USE phcom, ONLY : nq1, nq2, nq3 USE io_global, ONLY : stdout USE io_epw, ONLY : iunifc - USE noncollin_module, ONLY : noncolin, nspin_mag + USE noncollin_module, ONLY : nspin_mag USE io_dyn_mat2, ONLY : read_dyn_mat_param, read_dyn_mat_header,& read_dyn_mat, read_ifc_xml, read_ifc_param USE io_global, ONLY : ionode_id @@ -651,7 +654,7 @@ SUBROUTINE read_ifc ! implicit none ! - LOGICAL :: lpolar_, has_zstar + LOGICAL :: lpolar_, has_zstar, is_plain_text_file, is_xml_file CHARACTER (len=80) :: line CHARACTER(len=256) :: tempfile INTEGER :: ios, i, j, m1,m2,m3, na,nb, & @@ -672,10 +675,16 @@ SUBROUTINE read_ifc zstar=0.d0 epsi=0.d0 + ! generic name for the ifc.q2r file. If it is xml, the file will be named + ! ifc.q2r.xml instead + tempfile = TRIM(dvscf_dir) // 'ifc.q2r' + ! The following function will check if the file exists in xml format + CALL check_is_xml_file(tempfile, is_xml_file) + IF (mpime == ionode_id) THEN - IF (noncolin) THEN - ! - tempfile = trim(dvscf_dir) // 'ifc.q2r' + + IF (is_xml_file) THEN + ! pass the 'tempfile' as the '.xml' extension is added in the next routine CALL read_dyn_mat_param(tempfile,ntyp_,nat_) ALLOCATE (m_loc(3, nat_)) ALLOCATE (atm(ntyp_)) @@ -691,7 +700,6 @@ SUBROUTINE read_ifc ! ELSE ! - tempfile = trim(dvscf_dir) // 'ifc.q2r' OPEN(UNIT=iunifc,FILE=tempfile,status='old',iostat=ios) IF (ios /= 0) call errore ('read_ifc', 'error opening ifc.q2r',iunifc) ! @@ -1417,3 +1425,49 @@ subroutine sp3(u,v,i,na,nr1,nr2,nr3,nat,scal) end subroutine sp3 ! +!------------------------------------------------------------------------------- +SUBROUTINE check_is_xml_file(filename, is_xml_file) +!------------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + !! + !! This subroutine checks if a file is formatted in XML. It does so by + !! checking if the file exists and if the file + '.xml' in its name exists. + !! If both of them or none of them exists, an error is raised. If only one of + !! them exists, it sets the 'is_xml_file' to .true. of .false. depending of + !! the file found. + !! + !----------------------------------------------------------------------------- + IMPLICIT NONE + ! + ! input variables + ! + CHARACTER(len=256), INTENT(IN) :: filename + !! The name of the file to check if formatted in XML format + !! This string is assumed to be trimmed + LOGICAL, INTENT(OUT) :: is_xml_file + !! Is .true. if the file is in xml format. .false. otherwise. + ! + ! local variables + ! + CHARACTER(len=256) :: filename_xml, errmsg + LOGICAL :: is_plain_text_file + + filename_xml = TRIM(filename) // '.xml' + filename_xml = TRIM(filename_xml) + INQUIRE(FILE=filename, EXIST=is_plain_text_file) + INQUIRE(FILE=filename_xml, EXIST=is_xml_file) + ! Tell user if any inconsistencies + IF (is_xml_file .AND. is_plain_text_file) THEN + ! 2 different type of files exist => warn user + errmsg = "Detected both: '" // filename // "' and '" // filename_xml // & + &"' which one to choose?" + CALL errore('check_is_xml_file', errmsg, 1) + ELSE IF (.NOT. is_xml_file .AND. .NOT. is_plain_text_file) THEN + errmsg = "Expected a file named either '" // filename //"' or '"& + &// filename_xml // "' but none was found." + CALL errore('check_is_xml_file', errmsg, 1) + ENDIF + ! else one of the file in exists +!------------------------------------------------------------------------------ +END SUBROUTINE check_is_xml_file +!------------------------------------------------------------------------------ From fe7ad4e8416ee9aac305e30bd24f9db656c539ed Mon Sep 17 00:00:00 2001 From: Felix Goudreault Date: Wed, 5 Jun 2019 17:09:15 +0100 Subject: [PATCH 02/95] Modified pp.py script so that xml format is detected - Do not rely anymore on the fact that a calculation is noncolin to detect the xml format. As in the readmat_shuffle module, this is done by checking if a '.xml' file exists while the other 'unformatted' filename does not exists. --- EPW/bin/pp.py | 214 +++++++++++++++++++++++++++++--------------------- 1 file changed, 126 insertions(+), 88 deletions(-) diff --git a/EPW/bin/pp.py b/EPW/bin/pp.py index b7d0d98038..f35253c5ee 100644 --- a/EPW/bin/pp.py +++ b/EPW/bin/pp.py @@ -3,120 +3,158 @@ # Post-processing script from of PH data in format used by EPW # 14/07/2015 - Creation of the script - Samuel Ponce # 14/03/2018 - Automatically reads the number of q-points - Michael Waters -# 14/03/2018 - Detect if SOC is included in the calculation - Samuel Ponce -# +# 14/03/2018 - Detect if SOC is included in the calculation - Samuel Ponce +# 05/06/2019 - Removed SOC for xml detection instead - Felix Goudreault +# import numpy as np import os from xml.dom import minidom + # Return the number of q-points in the IBZ def get_nqpt(prefix): - fname = '_ph0/' +prefix+'.phsave/control_ph.xml' + fname = '_ph0/' + prefix + '.phsave/control_ph.xml' + + fid = open(fname, 'r') + lines = fid.readlines() + # these files are relatively small so reading the whole thing shouldn't + # be an issue + fid.close() - fid = open(fname,'r') - lines = fid.readlines() # these files are relatively small so reading the whole thing shouldn't be an issue - fid.close() + line_number_of_nqpt = 0 + while 'NUMBER_OF_Q_POINTS' not in lines[line_number_of_nqpt]: + # increment to line of interest + line_number_of_nqpt += 1 + line_number_of_nqpt += 1 # its on the next line after that text - line_number_of_nqpt = 0 - while 'NUMBER_OF_Q_POINTS' not in lines[line_number_of_nqpt]: # increment to line of interest - line_number_of_nqpt +=1 - line_number_of_nqpt +=1 # its on the next line after that text + nqpt = int(lines[line_number_of_nqpt]) - nqpt = int(lines[line_number_of_nqpt]) + return nqpt - return nqpt # Check if the calculation include SOC def hasSOC(prefix): - fname = prefix+'.save/data-file-schema.xml' + fname = prefix+'.save/data-file-schema.xml' + + xmldoc = minidom.parse(fname) + item = xmldoc.getElementsByTagName('spinorbit')[0] + lSOC = item.childNodes[0].data + + return lSOC + + +# check if calculation used xml files (irrelevant of presence of SOC) +def hasXML(prefix): + # check for a file named prefix.dyn1.xml + # if it exists => return True else return False + fname = os.path.join(prefix + ".dyn1.xml") + if os.path.isfile(fname): + return True + # check if the other without .xml extension exists + # if not raise an error + fname_no_xml = fname.strip(".xml") + if not os.path.isfile(fname_no_xml): + raise FileNotFoundError( + "No dyn0 file found cannot tell if xml format was used.") + return False - xmldoc = minidom.parse(fname) - item = xmldoc.getElementsByTagName('spinorbit')[0] - lSOC = item.childNodes[0].data - - return lSOC # Check if the calculation was done in sequential def isSEQ(prefix): - fname = '_ph0/'+str(prefix)+'.dvscf' - if (os.path.isfile(fname)): - lseq = True - else: - lseq = False - - return lseq - + fname = '_ph0/'+str(prefix)+'.dvscf' + if (os.path.isfile(fname)): + lseq = True + else: + lseq = False + + return lseq + + # Enter the number of irr. q-points -user_input = raw_input('Enter the prefix used for PH calculations (e.g. diam)\n') +user_input = input( + 'Enter the prefix used for PH calculations (e.g. diam)\n') prefix = str(user_input) -# Test if SOC -SOC = hasSOC(prefix) +# # Test if SOC +# SOC = hasSOC(prefix) +# Test if '.xml' files are used +XML = hasXML(prefix) # Test if seq. or parallel run SEQ = isSEQ(prefix) -if True: # this gets the nqpt from the outputfiles - nqpt = get_nqpt(prefix) +if True: # this gets the nqpt from the outputfiles + nqpt = get_nqpt(prefix) else: - # Enter the number of irr. q-points - user_input = raw_input('Enter the number of irreducible q-points\n') - nqpt = user_input - try: - nqpt = int(user_input) - except ValueError: - raise Exception('The value you enter is not an integer!') + # Enter the number of irr. q-points + user_input = input( + 'Enter the number of irreducible q-points\n') + nqpt = user_input + try: + nqpt = int(user_input) + except ValueError: + raise Exception('The value you enter is not an integer!') os.system('mkdir save 2>/dev/null') -for iqpt in np.arange(1,nqpt+1): - label = str(iqpt) - - # Case calculation in seq. - if SEQ: - # Case with SOC - if SOC == 'true': - os.system('cp '+prefix+'.dyn0 '+prefix+'.dyn0.xml') - os.system('cp '+prefix+'.dyn'+str(iqpt)+'.xml save/'+prefix+'.dyn_q'+label+'.xml') - if (iqpt == 1): - os.system('cp _ph0/'+prefix+'.dvscf* save/'+prefix+'.dvscf_q'+label) - os.system('cp -r _ph0/'+prefix+'.phsave save/') - os.system('cp '+prefix+'.fc.xml save/ifc.q2r.xml') - else: - os.system('cp _ph0/'+prefix+'.q_'+str(iqpt)+'/'+prefix+'.dvscf* save/'+prefix+'.dvscf_q'+label) - os.system('rm _ph0/'+prefix+'.q_'+str(iqpt)+'/*wfc*' ) - # Case without SOC - if SOC == 'false': - os.system('cp '+prefix+'.dyn'+str(iqpt)+' save/'+prefix+'.dyn_q'+label) - if (iqpt == 1): - os.system('cp _ph0/'+prefix+'.dvscf save/'+prefix+'.dvscf_q'+label) - os.system('cp -r _ph0/'+prefix+'.phsave save/') - os.system('cp '+prefix+'.fc save/ifc.q2r') - else: - os.system('cp _ph0/'+prefix+'.q_'+str(iqpt)+'/'+prefix+'.dvscf save/'+prefix+'.dvscf_q'+label) - os.system('rm _ph0/'+prefix+'.q_'+str(iqpt)+'/*wfc*' ) - - else: - # Case with SOC - if SOC == 'true': - os.system('cp '+prefix+'.dyn0 '+prefix+'.dyn0.xml') - os.system('cp '+prefix+'.dyn'+str(iqpt)+'.xml save/'+prefix+'.dyn_q'+label+'.xml') - if (iqpt == 1): - os.system('cp _ph0/'+prefix+'.dvscf1 save/'+prefix+'.dvscf_q'+label) - os.system('cp -r _ph0/'+prefix+'.phsave save/') - os.system('cp '+prefix+'.fc.xml save/ifc.q2r.xml') - else: - os.system('cp _ph0/'+prefix+'.q_'+str(iqpt)+'/'+prefix+'.dvscf1 save/'+prefix+'.dvscf_q'+label) - os.system('rm _ph0/'+prefix+'.q_'+str(iqpt)+'/*wfc*' ) - # Case without SOC - if SOC == 'false': - os.system('cp '+prefix+'.dyn'+str(iqpt)+' save/'+prefix+'.dyn_q'+label) - if (iqpt == 1): - os.system('cp _ph0/'+prefix+'.dvscf1 save/'+prefix+'.dvscf_q'+label) - os.system('cp -r _ph0/'+prefix+'.phsave save/') - os.system('cp '+prefix+'.fc save/ifc.q2r') - else: - os.system('cp _ph0/'+prefix+'.q_'+str(iqpt)+'/'+prefix+'.dvscf1 save/'+prefix+'.dvscf_q'+label) - os.system('rm _ph0/'+prefix+'.q_'+str(iqpt)+'/*wfc*' ) - +for iqpt in np.arange(1, nqpt+1): + label = str(iqpt) + + # Case calculation in seq. + if SEQ: + # Case with XML files + if XML: + os.system('cp '+prefix+'.dyn0 '+prefix+'.dyn0.xml') + os.system('cp '+prefix+'.dyn'+str(iqpt)+'.xml save/'+prefix + + '.dyn_q'+label+'.xml') + if (iqpt == 1): + os.system('cp _ph0/'+prefix+'.dvscf* save/'+prefix+'.dvscf_q' + + label) + os.system('cp -r _ph0/'+prefix+'.phsave save/') + os.system('cp '+prefix+'.fc.xml save/ifc.q2r.xml') + else: + os.system('cp _ph0/'+prefix+'.q_'+str(iqpt)+'/'+prefix + + '.dvscf* save/'+prefix+'.dvscf_q'+label) + os.system('rm _ph0/'+prefix+'.q_'+str(iqpt)+'/*wfc*') + # Case without XML files + else: + os.system('cp '+prefix+'.dyn'+str(iqpt)+' save/'+prefix+'.dyn_q' + + label) + if (iqpt == 1): + os.system('cp _ph0/'+prefix+'.dvscf save/'+prefix+'.dvscf_q' + + label) + os.system('cp -r _ph0/'+prefix+'.phsave save/') + os.system('cp '+prefix+'.fc save/ifc.q2r') + else: + os.system('cp _ph0/'+prefix+'.q_'+str(iqpt)+'/'+prefix + + '.dvscf save/'+prefix+'.dvscf_q'+label) + os.system('rm _ph0/'+prefix+'.q_'+str(iqpt)+'/*wfc*') + else: + # Case with XML format + if XML: + os.system('cp '+prefix+'.dyn0 '+prefix+'.dyn0.xml') + os.system('cp '+prefix+'.dyn'+str(iqpt)+'.xml save/'+prefix + + '.dyn_q'+label+'.xml') + if (iqpt == 1): + os.system('cp _ph0/'+prefix+'.dvscf1 save/'+prefix+'.dvscf_q' + + label) + os.system('cp -r _ph0/'+prefix+'.phsave save/') + os.system('cp '+prefix+'.fc.xml save/ifc.q2r.xml') + else: + os.system('cp _ph0/'+prefix+'.q_'+str(iqpt)+'/'+prefix + + '.dvscf1 save/'+prefix+'.dvscf_q'+label) + os.system('rm _ph0/'+prefix+'.q_'+str(iqpt)+'/*wfc*') + # Case without XML format + else: + os.system('cp '+prefix+'.dyn'+str(iqpt)+' save/'+prefix+'.dyn_q' + + label) + if (iqpt == 1): + os.system('cp _ph0/'+prefix+'.dvscf1 save/'+prefix+'.dvscf_q' + + label) + os.system('cp -r _ph0/'+prefix+'.phsave save/') + os.system('cp '+prefix+'.fc save/ifc.q2r') + else: + os.system('cp _ph0/'+prefix+'.q_'+str(iqpt)+'/'+prefix + + '.dvscf1 save/'+prefix+'.dvscf_q'+label) + os.system('rm _ph0/'+prefix+'.q_'+str(iqpt)+'/*wfc*') From 06dd00ceb16f881c40e855a3d31a5be85c0b090e Mon Sep 17 00:00:00 2001 From: giannozz Date: Wed, 19 Jun 2019 13:08:35 +0200 Subject: [PATCH 03/95] Minor documentation updates --- Doc/developer_man.tex | 17 +++++++++++++++++ Doc/release-notes | 4 +++- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/Doc/developer_man.tex b/Doc/developer_man.tex index 25d4167813..0e826e4db1 100644 --- a/Doc/developer_man.tex +++ b/Doc/developer_man.tex @@ -1297,6 +1297,23 @@ \subsection{Adding or modifying input variables} \end{verbatim} \end{enumerate} +\subsection{Updating documentation} +Input variable documentation for most codes is contained into a +\texttt{*/Doc/INPUT\_*.def} file. Simple utilities may have instead +the input documentation in the header of the code source. +Files .def are processed to produce .xml, .txt, .html files. +The latter is the most important, being the one that is available +online in the web site. + +The documentation must be processed with command ``make doc'' before +the release. Note that: +\begin{itemize} +\item in order to produce .xml, .txt, .html file, + "tcl", "tcllib", "xsltproc" are needed; +\item in order to build .pdf files from LaTeX, "pdflatex" is needed; +\item in order to build html files for user guide and developer manual, +"latex2html" and "convert" (from Image-Magick) are needed. +\end{itemize} \section{Using git} \label{Sec:git} diff --git a/Doc/release-notes b/Doc/release-notes index aab7c0e066..39836fa296 100644 --- a/Doc/release-notes +++ b/Doc/release-notes @@ -2,8 +2,10 @@ New in development branch: * turbo_eels code of TDDFPT module now works with ultrasoft pseudopotentials and spin-orbit coupling together (Oleksandr Motornyi, Andrea Dal Corso, Nathalie Vast). lr_sm1_psi.f90 of LR_Modules is rewritten and simplified. Problems fixed in development branch : + * Time reversal symmetry in tetrahedron routine incorrectly detected + after a restart in phonon (reported by T. Tadano) * pp.x with plot_num=11 in spin-polarized case was issuing a segmentation - fault error (nticed by Mauricio Chagas da Silva) + fault error (noticed by Mauricio Chagas da Silva) * pp.x with plot_num=17 in spin-polarized case was issuing a bogus error (noticed by Shoaib Muhammad, Sungkyunkwan U.) * vc-relax with cell_dofree='z' wasn't working exactly as expected From 43b6b151c2c348f3c2b43fc37aa53bf318ca464b Mon Sep 17 00:00:00 2001 From: giannozz Date: Wed, 19 Jun 2019 13:09:00 +0200 Subject: [PATCH 04/95] Misspell --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 78bd3f1529..2783fcdf0e 100644 --- a/Makefile +++ b/Makefile @@ -304,7 +304,7 @@ install : ######################################################### # Run test-suite for numerical regression testing # NB: it is assumed that reference outputs have been -# already computed once (usualy during release) +# already computed once (usually during release) ######################################################### test-suite: pw cp From 368e9f968b24e75f97f9dc4d6957bb286ef2030d Mon Sep 17 00:00:00 2001 From: giannozz Date: Wed, 19 Jun 2019 17:19:04 +0200 Subject: [PATCH 05/95] DOS calculation wasn't honoring "bz_sum='smearing'" if the nscf calculation was performed with tetrahedra, contrary to what stated in the documentation --- PP/Doc/INPUT_DOS.def | 2 +- PP/src/dos.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PP/Doc/INPUT_DOS.def b/PP/Doc/INPUT_DOS.def index b6e7db4776..2b01e20853 100644 --- a/PP/Doc/INPUT_DOS.def +++ b/PP/Doc/INPUT_DOS.def @@ -60,7 +60,7 @@ input_description -distribution {Quantum Espresso} -package PWscf -program dos.x see M. Kawamura, PRB 89, 094515 (2014). } } - default { 'smearing' if degauss in given in input 'smearing', + default { 'smearing' if degauss is given in input; options read from the xml data file otherwise. } } diff --git a/PP/src/dos.f90 b/PP/src/dos.f90 index b59f75b298..24b0480750 100644 --- a/PP/src/dos.f90 +++ b/PP/src/dos.f90 @@ -113,7 +113,7 @@ PROGRAM do_dos ltetra = .TRUE. tetra_type = 2 CASE default - IF ( .NOT. ltetra) tetra_type = -5 + tetra_type = -5 END SELECT IF ( ltetra .and. nk1*nk2*nk3 .eq. 0 ) & CALL errore ('dos:', 'tetrahedra integration selected on input can only be used with automatic ' //& From a59069eda158c5f4f02204d906d9040760cab2a6 Mon Sep 17 00:00:00 2001 From: giannozz Date: Wed, 19 Jun 2019 17:38:26 +0200 Subject: [PATCH 06/95] Release-notes updated --- Doc/release-notes | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Doc/release-notes b/Doc/release-notes index 39836fa296..9dd0f404c7 100644 --- a/Doc/release-notes +++ b/Doc/release-notes @@ -1,7 +1,12 @@ New in development branch: - * turbo_eels code of TDDFPT module now works with ultrasoft pseudopotentials and spin-orbit coupling together (Oleksandr Motornyi, Andrea Dal Corso, Nathalie Vast). lr_sm1_psi.f90 of LR_Modules is rewritten and simplified. + * turbo_eels code of TDDFPT module now works with ultrasoft pseudopotentials + and spin-orbit coupling together (Oleksandr Motornyi, Andrea Dal Corso, + Nathalie Vast). lr_sm1_psi.f90 of LR_Modules is rewritten and simplified. Problems fixed in development branch : + * DOS calculation wasn't honoring "bz_sum='smearing'" if the nscf + calculation was performed with tetrahedra, contrary to what stated + in the documentation (noticed by Mohammedreza Hosseini, Modares Univ.) * Time reversal symmetry in tetrahedron routine incorrectly detected after a restart in phonon (reported by T. Tadano) * pp.x with plot_num=11 in spin-polarized case was issuing a segmentation From 737c2aefb65a590fcb460616ce5a9f3202f21c21 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Wed, 19 Jun 2019 20:35:50 +0000 Subject: [PATCH 07/95] DFT+U: inconsistencies between different processors may still build up, even if the "ns" projections over the atomic manifold are broadcast after calculation. Broadcasting after mixing seems to solve the problem. --- PW/src/electrons.f90 | 11 ++++++++++- PW/src/new_ns.f90 | 14 ++++---------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/PW/src/electrons.f90 b/PW/src/electrons.f90 index 7ab756c060..301b1315a6 100644 --- a/PW/src/electrons.f90 +++ b/PW/src/electrons.f90 @@ -395,7 +395,8 @@ SUBROUTINE electrons_scf ( printout, exxen ) USE io_rho_xml, ONLY : write_scf USE uspp, ONLY : okvan USE mp_bands, ONLY : intra_bgrp_comm - USE mp_pools, ONLY : root_pool, my_pool_id, inter_pool_comm + USE mp_pools, ONLY : root_pool, me_pool, my_pool_id, & + inter_pool_comm, intra_pool_comm USE mp, ONLY : mp_sum, mp_bcast ! USE london_module, ONLY : energy_london @@ -654,6 +655,14 @@ SUBROUTINE electrons_scf ( printout, exxen ) ! IF ( my_pool_id == root_pool ) CALL mix_rho ( rho, rhoin, mixing_beta, dr2, tr2_min, iter, nmix, & iunmix, conv_elec ) + ! + IF ( lda_plus_u ) THEN + IF (noncolin) THEN + CALL mp_bcast( rhoin%ns_nc, my_pool_id, intra_pool_comm) + ELSE + CALL mp_bcast( rhoin%ns, my_pool_id, intra_pool_comm) + ENDIF + ENDIF CALL bcast_scf_type ( rhoin, root_pool, inter_pool_comm ) CALL mp_bcast ( dr2, root_pool, inter_pool_comm ) CALL mp_bcast ( conv_elec, root_pool, inter_pool_comm ) diff --git a/PW/src/new_ns.f90 b/PW/src/new_ns.f90 index 843575149d..c2b9feb102 100644 --- a/PW/src/new_ns.f90 +++ b/PW/src/new_ns.f90 @@ -36,8 +36,8 @@ SUBROUTINE new_ns(ns) USE wavefunctions, ONLY : evc USE io_files, ONLY : nwordwfc, iunwfc, nwordwfcU, iunhub USE buffers, ONLY : get_buffer - USE mp_pools, ONLY : inter_pool_comm, intra_pool_comm, root_pool - USE mp, ONLY : mp_sum, mp_bcast + USE mp_pools, ONLY : inter_pool_comm + USE mp, ONLY : mp_sum USE becmod, ONLY : bec_type, calbec, & allocate_bec_type, deallocate_bec_type @@ -197,9 +197,6 @@ SUBROUTINE new_ns(ns) ENDIF ENDDO - ! the following broadcast ensures consistency on different processors - ! of the same pool - CALL mp_bcast( ns, root_pool, intra_pool_comm ) CALL stop_clock('new_ns') RETURN @@ -302,8 +299,8 @@ SUBROUTINE new_ns_nc(ns) USE io_files, ONLY : nwordwfc, iunwfc, nwordwfcU, iunhub USE buffers, ONLY : get_buffer USE mp_bands, ONLY : intra_bgrp_comm - USE mp_pools, ONLY : inter_pool_comm, intra_pool_comm, root_pool - USE mp, ONLY : mp_sum, mp_bcast + USE mp_pools, ONLY : inter_pool_comm + USE mp, ONLY : mp_sum IMPLICIT NONE ! @@ -517,9 +514,6 @@ SUBROUTINE new_ns_nc(ns) ENDDO !-- DEALLOCATE ( nr, nr1 ) - ! the following broadcast ensures consistency on different processors - ! of the same pool - CALL mp_bcast( ns, root_pool, intra_pool_comm ) CALL stop_clock('new_ns') RETURN From 6b66f08a7510d380c1ee38368ee0cf5c29f294a2 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Wed, 19 Jun 2019 23:08:32 +0200 Subject: [PATCH 08/95] Label for B3LYP-V1R wasn't correct in the documentation (noticed by Zachary Windom, U. Florida) --- Modules/funct.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Modules/funct.f90 b/Modules/funct.f90 index 2048a722eb..b955c3071d 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -107,12 +107,12 @@ MODULE funct ! "tb09" = "sla+pw+tb09+tb09" = TB09 Meta-GGA ! "pbe0" = "pb0x+pw+pb0x+pbc" = PBE0 ! "b86bx" = "pb0x+pw+b86x+pbc" = B86bPBE hybrid - ! "bhahlyp" = "pb0x+pw+b88x+blyp" = Becke half-and-half LYP + ! "bhahlyp"="pb0x+pw+b88x+blyp" = Becke half-and-half LYP ! "hse" = "sla+pw+hse+pbc" = Heyd-Scuseria-Ernzerhof (HSE 06, see note below) - ! "b3lyp" = "b3lp+b3lp+b3lp+b3lp"= B3LYP - ! "b3lypv1r" = "b3lp+b3lpv1r+b3lp+b3lp"= B3LYP-VWN1-RPA - ! "x3lyp" = "x3lp+x3lp+x3lp+x3lp"= X3LYP - ! "vwn-rpa" = "sla+vwn-rpa" = VWN LDA using vwn1-rpa parametriz + ! "b3lyp" = B3LYP + ! "b3lyp-v1r" = B3LYP-VWN1-RPA + ! "x3lyp" = X3LYP + ! "vwn-rpa" = VWN LDA using vwn1-rpa parametrization ! "gaupbe"= "sla+pw+gaup+pbc" = Gau-PBE (also "gaup") ! "vdw-df" ="sla+pw+rpb +vdw1" = vdW-DF1 ! "vdw-df2" ="sla+pw+rw86+vdw2" = vdW-DF2 From 6316e9aee166fa0a25428d986d3f46718aa68e1b Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Thu, 20 Jun 2019 22:27:10 +0200 Subject: [PATCH 09/95] More I/O merge and some cleanup: exchange-correlation (beware: this mught be dangerous, given the large amount of variables involved) --- CPV/src/cp_restart_new.f90 | 14 +-- Modules/qexsd_copy.f90 | 51 +++------ PW/src/pw_restart_new.f90 | 224 +------------------------------------ PW/src/read_file_new.f90 | 60 +++++++--- 4 files changed, 70 insertions(+), 279 deletions(-) diff --git a/CPV/src/cp_restart_new.f90 b/CPV/src/cp_restart_new.f90 index d5f4542d35..4227cafd75 100644 --- a/CPV/src/cp_restart_new.f90 +++ b/CPV/src/cp_restart_new.f90 @@ -170,7 +170,6 @@ SUBROUTINE cp_writefile( ndw, ascii, nfi, simtime, acc, nk, xk, & INTEGER :: natomwfc, nbnd_, nb, ib REAL(DP), ALLOCATABLE :: mrepl(:,:) LOGICAL :: exst - INTEGER :: inlc TYPE(output_type) :: output_obj LOGICAL :: is_hubbard(ntypx), empirical_vdw TYPE(occupations_type) :: bands_occu @@ -513,8 +512,7 @@ SUBROUTINE cp_writefile( ndw, ascii, nfi, simtime, acc, nk, xk, & IF ( TRIM(sourcefile) /= TRIM(filename) ) & ierr = f_copy(sourcefile, filename) END DO - inlc = get_inlc() - IF ( inlc > 0 ) THEN + IF ( get_inlc() > 0 ) THEN sourcefile= TRIM(kernel_file_name) filename = TRIM(dirname)//TRIM(vdw_table_name) IF ( TRIM(sourcefile) /= TRIM(filename) ) & @@ -691,9 +689,8 @@ SUBROUTINE cp_readfile( ndr, ascii, nfi, simtime, acc, nk, xk, & TYPE (Node),POINTER :: root, nodePointer CHARACTER(LEN=20) :: dft_name CHARACTER(LEN=32) :: exxdiv_treatment, U_projection - CHARACTER(LEN=256):: vdw_corr - INTEGER :: nq1, nq2, nq3, lda_plus_U_kind, inlc - REAL(dp):: ecutfock, exx_fraction, screening_parameter, ecutvcut + INTEGER :: nq1, nq2, nq3, lda_plus_U_kind + REAL(dp):: exx_fraction, screening_parameter, ecutfock, ecutvcut,local_thr LOGICAL :: x_gamma_extrapolation REAL(dp):: hubbard_dum(3,nsp) CHARACTER(LEN=6), EXTERNAL :: int_to_char @@ -794,12 +791,11 @@ SUBROUTINE cp_readfile( ndr, ascii, nfi, simtime, acc, nk, xk, & CALL qexsd_copy_dft ( output_obj%dft, nsp, atm, dft_name, & nq1, nq2, nq3, ecutfock, exx_fraction, screening_parameter, & - exxdiv_treatment, x_gamma_extrapolation, ecutvcut, & + exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, & lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax,& Hubbard_U, Hubbard_dum(1,:), Hubbard_dum(2,:), Hubbard_dum(3,:), & Hubbard_dum, & - vdw_corr, llondon, ts_vdw, lxdm, inlc, vdw_table_name, scal6, & - lon_rcut, vdw_isolated) + llondon, ts_vdw, lxdm, vdw_table_name, scal6, lon_rcut, vdw_isolated) ! lsda_ = output_obj%magnetization%lsda IF ( lsda_ .AND. (nspin /= 2) ) CALL errore('cp_readfile','wrong spin',1) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index dcadd57f46..31b132cbe3 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -287,11 +287,10 @@ END SUBROUTINE qexsd_copy_basis_set !----------------------------------------------------------------------- SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & dft_name, nq1, nq2, nq3, ecutfock, exx_fraction, screening_parameter, & - exxdiv_treatment, x_gamma_extrapolation, ecutvcut, & + exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, & lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax, & Hubbard_U, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, & - vdw_corr, llondon, ts_vdw, lxdm, inlc, vdw_table_name, scal6, & - lon_rcut, vdw_isolated) + llondon, ts_vdw, lxdm, vdw_table_name, scal6, lon_rcut, vdw_isolated ) !------------------------------------------------------------------- ! USE qes_types_module, ONLY : dft_type @@ -306,7 +305,7 @@ SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & ! so that they do not forget their default value (if any) CHARACTER(LEN=*), INTENT(inout) :: exxdiv_treatment REAL(dp), INTENT(inout) :: ecutfock, exx_fraction, screening_parameter, & - ecutvcut + ecutvcut, local_thr INTEGER, INTENT(inout) :: nq1, nq2, nq3 LOGICAL, INTENT(inout) :: x_gamma_extrapolation ! @@ -317,10 +316,8 @@ SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & REAL(dp), INTENT(inout) :: Hubbard_U(:), Hubbard_J0(:), Hubbard_J(:,:), & Hubbard_alpha(:), Hubbard_beta(:) ! - CHARACTER(LEN=256), INTENT(out) :: vdw_corr CHARACTER(LEN=256), INTENT(inout) :: vdw_table_name LOGICAL, INTENT(out) :: llondon, ts_vdw, lxdm - INTEGER, INTENT(inout):: inlc REAL(dp), INTENT(inout) :: scal6, lon_rcut LOGICAL, INTENT(inout) :: vdw_isolated ! @@ -339,6 +336,11 @@ SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & exxdiv_treatment = dft_obj%hybrid%exxdiv_treatment x_gamma_extrapolation = dft_obj%hybrid%x_gamma_extrapolation ecutvcut = dft_obj%hybrid%ecutvcut + IF (dft_obj%hybrid%localization_threshold_ispresent) THEN + local_thr = dft_obj%hybrid%localization_threshold + ELSE + local_thr = 0._DP + END IF END IF ! lda_plus_u = dft_obj%dftU_ispresent @@ -419,11 +421,6 @@ SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & Hubbard_lmax = MAXVAL( Hubbard_l(1:nsp) ) END IF - IF ( dft_obj%vdW_ispresent ) THEN - vdw_corr = TRIM( dft_obj%vdW%vdw_corr ) - ELSE - vdw_corr = '' - END IF SELECT CASE( TRIM( dft_obj%vdW%vdw_corr ) ) ! CASE( 'grimme-d2', 'Grimme-D2', 'DFT-D', 'dft-d' ) @@ -451,29 +448,17 @@ SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & lxdm = .FALSE. ! END SELECT + ! the following lines set vdw_table_name, if not already set before + ! (the latter option, added by Yang Jiao, is useful for postprocessing) IF ( dft_obj%vdW_ispresent ) THEN - SELECT CASE ( TRIM (dft_obj%vdW%non_local_term)) - CASE ('vdw1') - inlc = 1 - CASE ('vdw2') - inlc = 2 - CASE ('vv10' ) - inlc = 3 - CASE ( 'vdW-DF-x') - inlc = 4 - CASE ( 'vdW-DF-y') - inlc = 5 - CASE ( 'vdW-DF-z') - inlc = 6 - CASE default - inlc = 0 - END SELECT - IF (inlc == 0 ) THEN - vdw_table_name = ' ' - ELSE IF ( inlc == 3 ) THEN - vdw_table_name = 'rVV10_kernel_table' - ELSE - vdw_table_name = 'vdW_kernel_table' + IF ( vdw_table_name == ' ' ) THEN + IF ( TRIM (dft_obj%vdW%non_local_term) == 'vv10') THEN + vdw_table_name = 'rVV10_kernel_table' + ELSE IF ( dft_obj%vdW%non_local_term(1:3) == 'vdw') THEN + vdw_table_name = 'vdW_kernel_table' + ELSE + vdw_table_name = '' + END IF END IF IF (dft_obj%vdW%london_s6_ispresent ) THEN scal6 = dft_obj%vdW%london_s6 diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index a32ec6a8b4..8caf868e7c 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -41,9 +41,9 @@ MODULE pw_restart_new PUBLIC :: pw_write_schema, pw_write_binaries, pw_read_schema, & read_collected_to_evc PUBLIC :: readschema_ef, readschema_spin, readschema_magnetization, & - readschema_xc, readschema_occupations, readschema_brillouin_zone, & + readschema_occupations, readschema_brillouin_zone, & readschema_band_structure, readschema_efield, & - readschema_outputPBC, readschema_exx + readschema_outputPBC ! CONTAINS !------------------------------------------------------------------------ @@ -1160,193 +1160,6 @@ SUBROUTINE readschema_magnetization( band_structure_obj, atomic_specs_obj, magne ! END SUBROUTINE readschema_magnetization !----------------------------------------------------------------------- - SUBROUTINE readschema_xc ( atomic_specs, dft_obj ) - !----------------------------------------------------------------------- - ! - USE funct, ONLY : enforce_input_dft - USE ldaU, ONLY : lda_plus_u, lda_plus_u_kind, Hubbard_lmax, & - Hubbard_l, Hubbard_U, Hubbard_J, Hubbard_alpha, & - Hubbard_J0, Hubbard_beta, U_projection - USE kernel_table, ONLY : vdw_table_name - USE control_flags, ONLY : llondon, lxdm, ts_vdw - USE london_module, ONLY : scal6, lon_rcut, in_C6 - USE tsvdw_module, ONLY : vdw_isolated - USE qes_types_module, ONLY : atomic_species_type, dft_type - ! - IMPLICIT NONE - ! - TYPE ( atomic_species_type ) :: atomic_specs - TYPE ( dft_type ) :: dft_obj - INTEGER :: ihub, nsp_, inlc, isp - ! - CHARACTER(LEN = 256 ) :: label - CHARACTER(LEN = 20 ) :: dft_name - CHARACTER(LEN = 3 ) :: symbol - ! - nsp_ = atomic_specs%ntyp - dft_name = TRIM(dft_obj%functional) - CALL enforce_input_dft ( dft_name, .TRUE. ) - lda_plus_u = dft_obj%dftU_ispresent - IF ( lda_plus_u ) THEN - lda_plus_u_kind = dft_obj%dftU%lda_plus_u_kind - U_projection = TRIM ( dft_obj%dftU%U_projection_type ) - Hubbard_l =-1 - IF ( dft_obj%dftU%Hubbard_U_ispresent) THEN - loop_on_hubbardU:DO ihub =1, dft_obj%dftU%ndim_Hubbard_U - symbol = TRIM(dft_obj%dftU%Hubbard_U(ihub)%specie) - label = TRIM(dft_obj%dftU%Hubbard_U(ihub)%label ) - loop_on_speciesU:DO isp = 1, nsp_ - IF ( TRIM(symbol) == TRIM ( atomic_specs%species(isp)%name) ) THEN - Hubbard_U(isp) = dft_obj%dftU%Hubbard_U(ihub)%HubbardCommon - SELECT CASE ( TRIM (label)) - CASE ( '1s', '2s', '3s', '4s', '5s', '6s', '7s' ) - Hubbard_l(isp) = 0 - CASE ( '2p', '3p', '4p', '5p', '6p' ) - Hubbard_l(isp) = 1 - CASE ( '3d', '4d', '5d' ) - Hubbard_l( isp ) = 2 - CASE ( '4f', '5f' ) - Hubbard_l(isp ) = 3 - CASE default - IF (Hubbard_U(isp)/=0) & - CALL errore ("readschema_xc:", "unrecognized label for Hubbard "//label, 1 ) - END SELECT - EXIT loop_on_speciesU - END IF - END DO loop_on_speciesU - END DO loop_on_hubbardU - END IF - - IF ( dft_obj%dftU%Hubbard_J0_ispresent ) THEN - loop_on_hubbardj0:DO ihub =1, dft_obj%dftU%ndim_Hubbard_J0 - symbol = TRIM(dft_obj%dftU%Hubbard_J0(ihub)%specie) - loop_on_speciesj0:DO isp = 1, nsp_ - IF ( TRIM(symbol) == TRIM ( atomic_specs%species(isp)%name) ) THEN - Hubbard_J0(isp) = dft_obj%dftU%Hubbard_J0(ihub)%HubbardCommon - EXIT loop_on_speciesj0 - END IF - END DO loop_on_speciesj0 - END DO loop_on_hubbardj0 - END IF - IF ( dft_obj%dftU%Hubbard_alpha_ispresent) THEN - loop_on_hubbardAlpha:DO ihub =1, dft_obj%dftU%ndim_Hubbard_alpha - symbol = TRIM(dft_obj%dftU%Hubbard_alpha(ihub)%specie) - loop_on_speciesAlpha:DO isp = 1, nsp_ - IF ( TRIM(symbol) == TRIM ( atomic_specs%species(isp)%name) ) THEN - Hubbard_alpha(isp) = dft_obj%dftU%Hubbard_alpha(ihub)%HubbardCommon - EXIT loop_on_speciesAlpha - END IF - END DO loop_on_speciesAlpha - END DO loop_on_hubbardAlpha - END IF - IF ( dft_obj%dftU%Hubbard_beta_ispresent) THEN - loop_on_hubbardBeta:DO ihub =1, dft_obj%dftU%ndim_Hubbard_beta - symbol = TRIM(dft_obj%dftU%Hubbard_beta(ihub)%specie) - loop_on_speciesBeta:DO isp = 1, nsp_ - IF ( TRIM(symbol) == TRIM ( atomic_specs%species(isp)%name) ) THEN - Hubbard_beta(isp) = dft_obj%dftU%Hubbard_beta(ihub)%HubbardCommon - EXIT loop_on_speciesBeta - END IF - END DO loop_on_speciesBeta - END DO loop_on_hubbardBeta - END IF - IF ( dft_obj%dftU%Hubbard_J_ispresent) THEN - loop_on_hubbardJ:DO ihub =1, dft_obj%dftU%ndim_Hubbard_J - symbol = TRIM(dft_obj%dftU%Hubbard_J(ihub)%specie) - loop_on_speciesJ:DO isp = 1, nsp_ - IF ( TRIM(symbol) == TRIM ( atomic_specs%species(isp)%name) ) THEN - Hubbard_J(:,isp) = dft_obj%dftU%Hubbard_J(ihub)%HubbardJ - EXIT loop_on_speciesJ - END IF - END DO loop_on_speciesJ - END DO loop_on_hubbardJ - END IF - Hubbard_lmax = MAXVAL( Hubbard_l(1:nsp_) ) - END IF - ! - IF ( dft_obj%vdW_ispresent ) THEN - SELECT CASE( TRIM( dft_obj%vdW%vdw_corr ) ) - ! - CASE( 'grimme-d2', 'Grimme-D2', 'DFT-D', 'dft-d' ) - ! - llondon= .TRUE. - ts_vdw= .FALSE. - lxdm = .FALSE. - ! - CASE( 'TS', 'ts', 'ts-vdw', 'ts-vdW', 'tkatchenko-scheffler' ) - ! - llondon= .FALSE. - ts_vdw= .TRUE. - lxdm = .FALSE. - ! - CASE( 'XDM', 'xdm' ) - ! - llondon= .FALSE. - ts_vdw= .FALSE. - lxdm = .TRUE. - ! - CASE DEFAULT - ! - llondon= .FALSE. - ts_vdw = .FALSE. - lxdm = .FALSE. - ! - END SELECT - ! the following lines set vdw_table_name, if not already set before - ! (the latter option, added by Yang Jiao, is useful for postprocessing) - ! NOTA BENE: inlc is not used - this part should be simplified and maybe - ! moved to somewhere else (e.g. a routine setting the default file name) - SELECT CASE ( TRIM (dft_obj%vdW%non_local_term)) - CASE ('vdw1') - inlc = 1 - CASE ('vdw2') - inlc = 2 - CASE ('vv10' ) - inlc = 3 - CASE ( 'vdW-DF-x') - inlc = 4 - CASE ( 'vdW-DF-y') - inlc = 5 - CASE ( 'vdW-DF-z') - inlc = 6 - CASE default - inlc = 0 - END SELECT - IF ( vdw_table_name == ' ' ) THEN - IF (inlc == 0 ) THEN - vdw_table_name = '' - ELSE IF ( inlc == 3 ) THEN - vdw_table_name = 'rVV10_kernel_table' - ELSE - vdw_table_name = 'vdW_kernel_table' - END IF - END IF - ! - IF (dft_obj%vdW%london_s6_ispresent ) THEN - scal6 = dft_obj%vdW%london_s6 - END IF - IF ( dft_obj%vdW%london_rcut_ispresent ) THEN - lon_rcut = dft_obj%vdW%london_rcut - END IF - IF ( dft_obj%vdW%london_c6_ispresent ) THEN - loop_on_londonC6:DO ihub =1, dft_obj%vdW%ndim_london_c6 - symbol = TRIM(dft_obj%vdW%london_c6(ihub)%specie) - loop_on_speciesC6:DO isp = 1, nsp_ - IF ( TRIM(symbol) == TRIM ( atomic_specs%species(isp)%name) ) THEN - in_C6(isp) = dft_obj%vdW%london_c6(ihub)%HubbardCommon - EXIT loop_on_speciesC6 - END IF - END DO loop_on_speciesC6 - END DO loop_on_londonC6 - END IF - ! - IF (dft_obj%vdW%ts_vdW_isolated_ispresent ) THEN - vdW_isolated = dft_obj%vdW%ts_vdW_isolated - END IF - END IF - ! - END SUBROUTINE readschema_xc - ! ! ! --------- For 2D cutoff: to read the fact that 2D cutoff was used in scf from new xml---------------- !----------------------------------------------------------------------------------------------------- @@ -1754,37 +1567,4 @@ SUBROUTINE readschema_ef ( band_struct_obj ) END IF END SUBROUTINE readschema_ef !------------------------------------------------------------------------ - SUBROUTINE readschema_exx ( hybrid_obj) - !------------------------------------------------------------------------ - ! - USE constants, ONLY : e2 - USE funct, ONLY : set_exx_fraction, set_screening_parameter, & - set_gau_parameter, enforce_input_dft, start_exx - USE exx_base, ONLY : x_gamma_extrapolation, nq1, nq2, nq3, & - exxdiv_treatment, yukawa, ecutvcut - USE exx, ONLY : ecutfock, local_thr - ! - USE qes_types_module, ONLY : hybrid_type - IMPLICIT NONE - ! - TYPE ( hybrid_type), INTENT(IN) :: hybrid_obj - ! - x_gamma_extrapolation = hybrid_obj%x_gamma_extrapolation - nq1 = hybrid_obj%qpoint_grid%nqx1 - nq2 = hybrid_obj%qpoint_grid%nqx2 - nq3 = hybrid_obj%qpoint_grid%nqx3 - CALL set_exx_fraction( hybrid_obj%exx_fraction) - CALL set_screening_parameter ( hybrid_obj%screening_parameter) - exxdiv_treatment = hybrid_obj%exxdiv_treatment - ecutvcut = hybrid_obj%ecutvcut*e2 - ecutfock = hybrid_obj%ecutfock*e2 - IF (hybrid_obj%localization_threshold_ispresent) THEN - local_thr = hybrid_obj%localization_threshold - ELSE - local_thr = 0._DP - END IF - CALL start_exx() - END SUBROUTINE readschema_exx - !----------------------------------------------------------------------------------- - END MODULE pw_restart_new diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 5ce74d8ce1..5f201f9c7b 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -89,6 +89,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! ... All quantities that are initialized in subroutine "setup" when ! ... starting from scratch should be initialized here when restarting ! + USE kinds, ONLY : dp USE constants, ONLY : e2 USE gvect, ONLY : ngm_g, ecutrho USE gvecs, ONLY : ngms_g, dual @@ -109,7 +110,19 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE symm_base, ONLY : nrot, nsym, invsym, s, ft, irt, t_rev, & sname, inverse_s, s_axis_to_cart, & time_reversal, no_t_rev, nosym, checkallsym - USE control_flags, ONLY : noinv, gamma_only, tqr + USE funct, ONLY : enforce_input_dft, dft_is_hybrid + USE kernel_table, ONLY : vdw_table_name + USE ldaU, ONLY : lda_plus_u, lda_plus_u_kind, Hubbard_lmax, & + Hubbard_l, Hubbard_U, Hubbard_J, Hubbard_alpha, & + Hubbard_J0, Hubbard_beta, U_projection + USE london_module, ONLY : scal6, lon_rcut, in_C6 + USE tsvdw_module, ONLY : vdw_isolated + USE funct, ONLY : set_exx_fraction, set_screening_parameter, & + set_gau_parameter, enforce_input_dft, start_exx + USE exx_base, ONLY : x_gamma_extrapolation, nq1, nq2, nq3, & + exxdiv_treatment, yukawa, ecutvcut + USE exx, ONLY : ecutfock, local_thr + USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, lxdm, ts_vdw USE noncollin_module,ONLY : noncolin USE spin_orb, ONLY : domag USE realus, ONLY : real_space @@ -117,17 +130,18 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE paw_variables, ONLY : okpaw ! USE pw_restart_new, ONLY : pw_read_schema, & - readschema_spin, readschema_magnetization, readschema_xc, & + readschema_spin, readschema_magnetization, & readschema_occupations, readschema_brillouin_zone, & readschema_band_structure, readschema_efield, & - readschema_outputPBC, readschema_exx + readschema_outputPBC USE qes_types_module,ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset USE qexsd_copy, ONLY : qexsd_copy_parallel_info, & qexsd_copy_dim, qexsd_copy_atomic_species, & qexsd_copy_atomic_structure, qexsd_copy_symmetry, & - qexsd_copy_basis_set, qexsd_copy_algorithmic_info + qexsd_copy_basis_set, qexsd_copy_algorithmic_info,& + qexsd_copy_dft #if defined(__BEOWULF) USE qes_bcast_module,ONLY : qes_bcast @@ -137,13 +151,15 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! IMPLICIT NONE LOGICAL, INTENT(OUT) :: wfc_is_collected - + ! INTEGER :: i, is, ik, ibnd, nb, nt, ios, isym, ierr, dum1,dum2,dum3 LOGICAL :: magnetic_sym, lvalid_input - TYPE ( output_type) :: output_obj - TYPE (parallel_info_type) :: parinfo_obj - TYPE (general_info_type ) :: geninfo_obj - TYPE (input_type) :: input_obj + CHARACTER(LEN=20) :: dft_name + REAL(dp) :: exx_fraction, screening_parameter + TYPE (output_type) :: output_obj + TYPE (parallel_info_type) :: parinfo_obj + TYPE (general_info_type ) :: geninfo_obj + TYPE (input_type) :: input_obj ! ! #if defined(__BEOWULF) @@ -212,18 +228,35 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) tau(:,1:nat) = tau(:,1:nat)/alat CALL at2celldm (ibrav,alat,at(:,1),at(:,2),at(:,3),celldm) CALL volume (alat,at(:,1),at(:,2),at(:,3),omega) - ! + !! + !! Basis set section CALL qexsd_copy_basis_set ( output_obj%basis_set, gamma_only, ecutwfc,& ecutrho, dffts%nr1,dffts%nr2,dffts%nr3, dfftp%nr1,dfftp%nr2,dfftp%nr3, & dum1,dum2,dum3, ngm_g, ngms_g, npwx, bg(:,1), bg(:,2), bg(:,3) ) ecutwfc = ecutwfc*e2 ecutrho = ecutrho*e2 dual = ecutrho/ecutwfc - ! + !! + !! DFT section + CALL qexsd_copy_dft ( output_obj%dft, nsp, atm, & + dft_name, nq1, nq2, nq3, ecutfock, exx_fraction, screening_parameter, & + exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, & + lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax, & + Hubbard_U, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, & + llondon, ts_vdw, lxdm, vdw_table_name, scal6, lon_rcut, vdw_isolated ) + !! More DFT initializations + CALL enforce_input_dft ( dft_name, .TRUE. ) + IF ( dft_is_hybrid() ) THEN + ecutvcut=ecutvcut*e2 + ecutfock=ecutfock*e2 + CALL set_exx_fraction( exx_fraction) + CALL set_screening_parameter ( screening_parameter) + CALL start_exx () + END IF + !! CALL readschema_spin( output_obj%magnetization ) CALL readschema_magnetization ( output_obj%band_structure, & output_obj%atomic_species, output_obj%magnetization ) - CALL readschema_xc ( output_obj%atomic_species, output_obj%dft ) CALL readschema_occupations( output_obj%band_structure ) CALL readschema_brillouin_zone( output_obj%symmetries, output_obj%band_structure ) CALL readschema_band_structure( output_obj%band_structure ) @@ -247,9 +280,6 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) IF (nat > 0) CALL checkallsym( nat, tau, ityp) ! CALL readschema_outputPBC ( output_obj%boundary_conditions) - IF ( output_obj%dft%hybrid_ispresent ) THEN - CALL readschema_exx ( output_obj%dft%hybrid ) - END IF CALL qexsd_copy_algorithmic_info ( output_obj%algorithmic_info, & real_space, tqr, okvan, okpaw ) ! From dd05ffc651cd9cb2e22490c3c4eff243fc4ce2ab Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Thu, 20 Jun 2019 22:58:18 +0200 Subject: [PATCH 10/95] Minor changes --- PW/src/read_file_new.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 5f201f9c7b..ed4e27f861 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -110,15 +110,15 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE symm_base, ONLY : nrot, nsym, invsym, s, ft, irt, t_rev, & sname, inverse_s, s_axis_to_cart, & time_reversal, no_t_rev, nosym, checkallsym - USE funct, ONLY : enforce_input_dft, dft_is_hybrid - USE kernel_table, ONLY : vdw_table_name USE ldaU, ONLY : lda_plus_u, lda_plus_u_kind, Hubbard_lmax, & Hubbard_l, Hubbard_U, Hubbard_J, Hubbard_alpha, & Hubbard_J0, Hubbard_beta, U_projection + USE funct, ONLY : set_exx_fraction, set_screening_parameter, & + set_gau_parameter, enforce_input_dft, & + start_exx, dft_is_hybrid USE london_module, ONLY : scal6, lon_rcut, in_C6 USE tsvdw_module, ONLY : vdw_isolated - USE funct, ONLY : set_exx_fraction, set_screening_parameter, & - set_gau_parameter, enforce_input_dft, start_exx + USE kernel_table, ONLY : vdw_table_name USE exx_base, ONLY : x_gamma_extrapolation, nq1, nq2, nq3, & exxdiv_treatment, yukawa, ecutvcut USE exx, ONLY : ecutfock, local_thr @@ -249,8 +249,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) IF ( dft_is_hybrid() ) THEN ecutvcut=ecutvcut*e2 ecutfock=ecutfock*e2 - CALL set_exx_fraction( exx_fraction) - CALL set_screening_parameter ( screening_parameter) + CALL set_exx_fraction( exx_fraction ) + CALL set_screening_parameter ( screening_parameter ) CALL start_exx () END IF !! From a27ae6c0983e76f95324f66cc1d9aff43517aff0 Mon Sep 17 00:00:00 2001 From: paoloumari Date: Fri, 21 Jun 2019 13:03:22 +0200 Subject: [PATCH 11/95] Bug corrected. --- GWW/simple/v_product.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GWW/simple/v_product.f90 b/GWW/simple/v_product.f90 index d4575ab84d..d42706b31a 100644 --- a/GWW/simple/v_product.f90 +++ b/GWW/simple/v_product.f90 @@ -239,6 +239,7 @@ subroutine v_product enddo enddo enddo + fac(ig)=fac(ig)*e2*fpi/(8.d0*(dble(n_int))**3.d0)/tpiba fac(ig)=fac(ig)*model else fac(ig)=0.d0 From e28ac4a0ad84459414299e73fdfd97a80a42efaf Mon Sep 17 00:00:00 2001 From: paoloumari Date: Fri, 21 Jun 2019 13:33:55 +0200 Subject: [PATCH 12/95] Modified evaluation of b factor for improving stability, --- GWW/simple_bse/lanczos.f90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/GWW/simple_bse/lanczos.f90 b/GWW/simple_bse/lanczos.f90 index 8a9dce1034..a150ece067 100644 --- a/GWW/simple_bse/lanczos.f90 +++ b/GWW/simple_bse/lanczos.f90 @@ -89,6 +89,13 @@ subroutine lanczos(data_input) call hamiltonian(data_input, 1, bd, pp, pt, pm, x, Hx,0) csca=x*Hx a(i) = cmplx(dble(csca),0.d0) +!added this 22/1/18 + if(i>1) then + csca=xm1*Hx + b(i-1) = cmplx(dble(csca),0.d0) + + endif + if (i==1) then etmp1=a(i)*(-1.d0,0.d0)*x call sum_exc_sub(etmp2,Hx,etmp1) @@ -128,6 +135,7 @@ subroutine lanczos(data_input) call sum_exc_sub(etmp3,etmp1,etmp2) call sum_exc_sub(etmp4,Hx,etmp3) x1= (1/b(i))*etmp4 + call normalize_exc(x1)!Added 22/2/18 ! x1 = (1/b(i))*(Hx+(-1.d0,0.d0)*(a(i)*x+b(i-1)*xm1))! (|i+1>= H|i>-a_i|i>-b_{i-1}|i-1>)/b_i xm1 = x!|i-1> = |i> From e9607e2d63401ea9418116f5d5d6e072bf353a34 Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Fri, 21 Jun 2019 14:27:54 +0200 Subject: [PATCH 13/95] A fix related to exx_fraction with libxc --- Modules/funct.f90 | 31 ++++++++++++++++--------------- PW/src/input.f90 | 22 ++-------------------- 2 files changed, 18 insertions(+), 35 deletions(-) diff --git a/Modules/funct.f90 b/Modules/funct.f90 index b955c3071d..d7e142b488 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -35,6 +35,10 @@ MODULE funct ! USE io_global, ONLY: stdout USE kinds, ONLY: DP +#if defined(__LIBXC) + USE xc_f90_types_m + USE xc_f90_lib_m +#endif ! IMPLICIT NONE ! @@ -378,10 +382,6 @@ SUBROUTINE set_dft_from_name( dft_ ) !----------------------------------------------------------------------- !! Translates a string containing the exchange-correlation name !! into internal indices iexch, icorr, igcx, igcc, inlc, imeta. -#if defined(__LIBXC) - USE xc_f90_types_m - USE xc_f90_lib_m -#endif ! IMPLICIT NONE ! @@ -734,11 +734,6 @@ END SUBROUTINE set_dft_from_name FUNCTION matching( fslot, dft, n, name, its_libxc ) !------------------------------------------------------------ ! -#if defined(__LIBXC) - USE xc_f90_types_m - USE xc_f90_lib_m -#endif - ! IMPLICIT NONE ! INTEGER :: matching @@ -819,11 +814,6 @@ END FUNCTION matching FUNCTION slot_match_libxc( fslot, family, fkind ) !------------------------------------------------------------------------- ! -#if defined(__LIBXC) - USE xc_f90_types_m - USE xc_f90_lib_m -#endif - ! IMPLICIT NONE ! LOGICAL :: slot_match_libxc @@ -1107,7 +1097,18 @@ FUNCTION dft_is_nonlocc() END FUNCTION dft_is_nonlocc !----------------------------------------------------------------------- FUNCTION get_exx_fraction() - REAL(DP):: get_exx_fraction + REAL(DP) :: get_exx_fraction +#if defined(__LIBXC) + INTEGER :: family + TYPE(xc_f90_pointer_t) :: xc_func, xc_info + ! + IF ( is_libxc(3) ) THEN + CALL xc_f90_func_init( xc_func, xc_info, igcx, 1 ) + family = xc_f90_info_family( xc_info ) + IF (family == XC_FAMILY_HYB_GGA) CALL xc_f90_hyb_exx_coef( xc_func, exx_fraction ) + CALL xc_f90_func_end( xc_func ) + ENDIF +#endif get_exx_fraction = exx_fraction RETURN END FUNCTION get_exx_fraction diff --git a/PW/src/input.f90 b/PW/src/input.f90 index 8d8172cef9..548ddc4419 100644 --- a/PW/src/input.f90 +++ b/PW/src/input.f90 @@ -16,8 +16,8 @@ SUBROUTINE iosys() ! USE kinds, ONLY : DP USE funct, ONLY : dft_is_hybrid, dft_has_finite_size_correction, & - set_finite_size_volume, get_inlc, get_dft_short, is_libxc - USE funct, ONLY: set_exx_fraction, set_screening_parameter, get_igcx + set_finite_size_volume, get_inlc, get_dft_short + USE funct, ONLY: set_exx_fraction, set_screening_parameter USE control_flags, ONLY: adapt_thr, tr2_init, tr2_multi USE constants, ONLY : autoev, eV_to_kelvin, pi, rytoev, & ry_kbar, amu_ry, bohr_radius_angs, eps8 @@ -317,11 +317,6 @@ SUBROUTINE iosys() ! USE vlocal, ONLY : starting_charge_ => starting_charge ! -#if defined(__LIBXC) - USE xc_f90_types_m - USE xc_f90_lib_m -#endif - ! IMPLICIT NONE ! INTERFACE @@ -340,10 +335,6 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) INTEGER :: ia, nt, inlc, ibrav_sg, ierr LOGICAL :: exst, parallelfs REAL(DP) :: theta, phi, ecutwfc_pp, ecutrho_pp -#if defined(__LIBXC) - INTEGER :: igcx, family - TYPE(xc_f90_pointer_t) :: xc_func, xc_info -#endif ! ! ... various initializations of control variables ! @@ -1634,15 +1625,6 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) ! ... must be done AFTER dft is read from PP files and initialized ! ... or else the two following parameters will be overwritten ! -#if defined(__LIBXC) - IF ( is_libxc(3) ) THEN - igcx = get_igcx() - CALL xc_f90_func_init( xc_func, xc_info, igcx, 1 ) - family = xc_f90_info_family( xc_info ) - IF (family == XC_FAMILY_HYB_GGA) CALL xc_f90_hyb_exx_coef( xc_func, exx_fraction ) - CALL xc_f90_func_end( xc_func ) - ENDIF -#endif IF (exx_fraction >= 0.0_DP) CALL set_exx_fraction (exx_fraction) ! IF (screening_parameter >= 0.0_DP) & From 6e678615544256eca61710a3e35e866342854929 Mon Sep 17 00:00:00 2001 From: giannozz Date: Fri, 21 Jun 2019 18:43:56 +0200 Subject: [PATCH 14/95] Cleanup: symmetries were read twice --- PW/src/pw_restart_new.f90 | 12 ++---------- PW/src/read_file_new.f90 | 2 +- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 8caf868e7c..d6ea784ae3 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -1178,19 +1178,17 @@ SUBROUTINE readschema_outputPBC( boundary_conditions_obj ) ! END SUBROUTINE readschema_outputPBC !----------------------------------------------------------------------------------------------------- - SUBROUTINE readschema_brillouin_zone( symmetries_obj, band_structure ) + SUBROUTINE readschema_brillouin_zone( band_structure ) !----------------------------------------------------------------------------------------------------- ! USE lsda_mod, ONLY : lsda, isk USE klist, ONLY : nkstot, xk, wk USE start_k, ONLY : nks_start, xk_start, wk_start, & nk1, nk2, nk3, k1, k2, k3 - USE symm_base,ONLY : nrot, s, sname - USE qes_types_module, ONLY : k_points_IBZ_type, occupations_type, symmetries_type, band_structure_type + USE qes_types_module, ONLY : band_structure_type ! IMPLICIT NONE ! - TYPE ( symmetries_type ), INTENT(IN) :: symmetries_obj TYPE ( band_structure_type ),INTENT(IN) :: band_structure INTEGER :: ik, isym, nks_ ! @@ -1246,12 +1244,6 @@ SUBROUTINE readschema_brillouin_zone( symmetries_obj, band_structure ) " no information found for initializing brillouin zone information", 1) END IF ! - nrot = symmetries_obj%nrot - DO isym =1, symmetries_obj%ndim_symmetry - s(:,:,isym) = reshape(symmetries_obj%symmetry(isym)%rotation%matrix, [3,3]) - sname(isym) = TRIM ( symmetries_obj%symmetry(isym)%info%name) - END DO - ! END SUBROUTINE readschema_brillouin_zone !-------------------------------------------------------------------------------------------------- SUBROUTINE readschema_occupations( band_struct_obj ) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index ed4e27f861..97357edcc6 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -258,7 +258,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL readschema_magnetization ( output_obj%band_structure, & output_obj%atomic_species, output_obj%magnetization ) CALL readschema_occupations( output_obj%band_structure ) - CALL readschema_brillouin_zone( output_obj%symmetries, output_obj%band_structure ) + CALL readschema_brillouin_zone( output_obj%band_structure ) CALL readschema_band_structure( output_obj%band_structure ) !! Symmetry section IF ( lvalid_input ) THEN From b88ade188fbb22308340f862aecb78bc7acbe621 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Fri, 21 Jun 2019 19:54:26 +0200 Subject: [PATCH 15/95] Some more cleanup: read what is written, that is, vdw_corr, instead of logical variables (that may be code-dependent=; use a same small routine to set those logical variables everywhere --- CPV/src/cp_restart_new.f90 | 7 +++-- Modules/Makefile | 1 + Modules/qexsd_copy.f90 | 37 ++++++-------------------- Modules/set_vdw_corr.f90 | 54 ++++++++++++++++++++++++++++++++++++++ PW/src/input.f90 | 44 ++----------------------------- PW/src/read_file_new.f90 | 8 +++--- 6 files changed, 75 insertions(+), 76 deletions(-) create mode 100644 Modules/set_vdw_corr.f90 diff --git a/CPV/src/cp_restart_new.f90 b/CPV/src/cp_restart_new.f90 index 4227cafd75..7d75e20ee8 100644 --- a/CPV/src/cp_restart_new.f90 +++ b/CPV/src/cp_restart_new.f90 @@ -687,8 +687,9 @@ SUBROUTINE cp_readfile( ndr, ascii, nfi, simtime, acc, nk, xk, & TYPE (parallel_info_type) :: parinfo_obj TYPE (general_info_type ) :: geninfo_obj TYPE (Node),POINTER :: root, nodePointer - CHARACTER(LEN=20) :: dft_name + CHARACTER(LEN=20) :: dft_name, vdw_corr CHARACTER(LEN=32) :: exxdiv_treatment, U_projection + LOGICAL :: ldftd3 INTEGER :: nq1, nq2, nq3, lda_plus_U_kind REAL(dp):: exx_fraction, screening_parameter, ecutfock, ecutvcut,local_thr LOGICAL :: x_gamma_extrapolation @@ -795,7 +796,9 @@ SUBROUTINE cp_readfile( ndr, ascii, nfi, simtime, acc, nk, xk, & lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax,& Hubbard_U, Hubbard_dum(1,:), Hubbard_dum(2,:), Hubbard_dum(3,:), & Hubbard_dum, & - llondon, ts_vdw, lxdm, vdw_table_name, scal6, lon_rcut, vdw_isolated) + vdw_corr, vdw_table_name, scal6, lon_rcut, vdw_isolated) + CALL set_vdw_corr (vdw_corr, llondon, ldftd3, ts_vdw, lxdm ) + IF ( ldftd3 ) CALL errore('cp_readfile','DFT-D3 not implemented',1) ! lsda_ = output_obj%magnetization%lsda IF ( lsda_ .AND. (nspin /= 2) ) CALL errore('cp_readfile','wrong spin',1) diff --git a/Modules/Makefile b/Modules/Makefile index 750a5dfbbd..2683d74e76 100644 --- a/Modules/Makefile +++ b/Modules/Makefile @@ -88,6 +88,7 @@ recvec_subs.o \ run_info.o \ space_group.o \ set_signal.o \ +set_vdw_corr.o \ setqf.o \ splinelib.o \ timestep.o\ diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 31b132cbe3..e9b2612868 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -290,7 +290,7 @@ SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, & lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax, & Hubbard_U, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, & - llondon, ts_vdw, lxdm, vdw_table_name, scal6, lon_rcut, vdw_isolated ) + vdw_corr, vdw_table_name, scal6, lon_rcut, vdw_isolated ) !------------------------------------------------------------------- ! USE qes_types_module, ONLY : dft_type @@ -317,7 +317,7 @@ SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & Hubbard_alpha(:), Hubbard_beta(:) ! CHARACTER(LEN=256), INTENT(inout) :: vdw_table_name - LOGICAL, INTENT(out) :: llondon, ts_vdw, lxdm + CHARACTER(LEN=*), INTENT(out) :: vdw_corr REAL(dp), INTENT(inout) :: scal6, lon_rcut LOGICAL, INTENT(inout) :: vdw_isolated ! @@ -421,33 +421,12 @@ SUBROUTINE qexsd_copy_dft ( dft_obj, nsp, atm, & Hubbard_lmax = MAXVAL( Hubbard_l(1:nsp) ) END IF - SELECT CASE( TRIM( dft_obj%vdW%vdw_corr ) ) - ! - CASE( 'grimme-d2', 'Grimme-D2', 'DFT-D', 'dft-d' ) - ! - llondon= .TRUE. - ts_vdw= .FALSE. - lxdm = .FALSE. - ! - CASE( 'TS', 'ts', 'ts-vdw', 'ts-vdW', 'tkatchenko-scheffler' ) - ! - llondon= .FALSE. - ts_vdw= .TRUE. - lxdm = .FALSE. - ! - CASE( 'XDM', 'xdm' ) - ! - llondon= .FALSE. - ts_vdw= .FALSE. - lxdm = .TRUE. - ! - CASE DEFAULT - ! - llondon= .FALSE. - ts_vdw = .FALSE. - lxdm = .FALSE. - ! - END SELECT + IF ( dft_obj%vdW_ispresent ) THEN + vdw_corr = TRIM( dft_obj%vdW%vdw_corr ) + ELSE + vdw_corr = '' + END IF + ! the following lines set vdw_table_name, if not already set before ! (the latter option, added by Yang Jiao, is useful for postprocessing) IF ( dft_obj%vdW_ispresent ) THEN diff --git a/Modules/set_vdw_corr.f90 b/Modules/set_vdw_corr.f90 new file mode 100644 index 0000000000..d6c1dbebd9 --- /dev/null +++ b/Modules/set_vdw_corr.f90 @@ -0,0 +1,54 @@ + +! Copyright (C) 2019 Quantum ESPRESSO Foundation +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +! +SUBROUTINE set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw_, lxdm ) + ! + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(in) :: vdw_corr + LOGICAL, INTENT(out) :: llondon, ldftd3, ts_vdw_, lxdm + ! + SELECT CASE( TRIM( vdw_corr ) ) + ! + CASE( 'grimme-d2', 'Grimme-D2', 'DFT-D', 'dft-d' ) + ! + llondon= .TRUE. + ldftd3 = .FALSE. + ts_vdw_= .FALSE. + lxdm = .FALSE. + ! + CASE( 'grimme-d3', 'Grimme-D3', 'DFT-D3', 'dft-d3' ) + ! + ldftd3 = .TRUE. + llondon= .FALSE. + ts_vdw_= .FALSE. + lxdm = .FALSE. + ! + CASE( 'TS', 'ts', 'ts-vdw', 'ts-vdW', 'tkatchenko-scheffler' ) + ! + llondon= .FALSE. + ldftd3 = .FALSE. + ts_vdw_= .TRUE. + lxdm = .FALSE. + ! + CASE( 'XDM', 'xdm' ) + ! + llondon= .FALSE. + ldftd3 = .FALSE. + ts_vdw_= .FALSE. + lxdm = .TRUE. + ! + CASE DEFAULT + ! + llondon= .FALSE. + ldftd3 = .FALSE. + ts_vdw_= .FALSE. + lxdm = .FALSE. + ! + END SELECT + +END SUBROUTINE set_vdw_corr diff --git a/PW/src/input.f90 b/PW/src/input.f90 index 548ddc4419..ed10a7a13b 100644 --- a/PW/src/input.f90 +++ b/PW/src/input.f90 @@ -1250,53 +1250,13 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) ! ! ... initialize variables for vdW (dispersions) corrections ! - SELECT CASE( TRIM( vdw_corr ) ) - ! - CASE( 'grimme-d2', 'Grimme-D2', 'DFT-D', 'dft-d' ) - ! - llondon= .TRUE. - ldftd3 = .FALSE. - ts_vdw_= .FALSE. - lxdm = .FALSE. - ! - CASE( 'grimme-d3', 'Grimme-D3', 'DFT-D3', 'dft-d3' ) - ! - ldftd3 = .TRUE. - llondon= .FALSE. - ts_vdw_= .FALSE. - lxdm = .FALSE. - ! - - CASE( 'TS', 'ts', 'ts-vdw', 'ts-vdW', 'tkatchenko-scheffler' ) - ! - llondon= .FALSE. - ldftd3 = .FALSE. - ts_vdw_= .TRUE. - lxdm = .FALSE. - ! - CASE( 'XDM', 'xdm' ) - ! - llondon= .FALSE. - ldftd3 = .FALSE. - ts_vdw_= .FALSE. - lxdm = .TRUE. - ! - CASE DEFAULT - ! - llondon= .FALSE. - ldftd3 = .FALSE. - ts_vdw_= .FALSE. - lxdm = .FALSE. - ! - END SELECT + CALL set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw_, lxdm) + ! IF ( london ) THEN CALL infomsg("iosys","london is obsolete, use ""vdw_corr='grimme-d2'"" instead") vdw_corr='grimme-d2' llondon = .TRUE. END IF - IF ( ldftd3 ) THEN - vdw_corr='grimme-d3' - ENDIF IF ( xdm ) THEN CALL infomsg("iosys","xdm is obsolete, use ""vdw_corr='xdm'"" instead") vdw_corr='xdm' diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 97357edcc6..edbee61d72 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -122,7 +122,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE exx_base, ONLY : x_gamma_extrapolation, nq1, nq2, nq3, & exxdiv_treatment, yukawa, ecutvcut USE exx, ONLY : ecutfock, local_thr - USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, lxdm, ts_vdw + USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, ldftd3, & + lxdm, ts_vdw USE noncollin_module,ONLY : noncolin USE spin_orb, ONLY : domag USE realus, ONLY : real_space @@ -154,7 +155,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! INTEGER :: i, is, ik, ibnd, nb, nt, ios, isym, ierr, dum1,dum2,dum3 LOGICAL :: magnetic_sym, lvalid_input - CHARACTER(LEN=20) :: dft_name + CHARACTER(LEN=20) :: dft_name, vdw_corr REAL(dp) :: exx_fraction, screening_parameter TYPE (output_type) :: output_obj TYPE (parallel_info_type) :: parinfo_obj @@ -243,8 +244,9 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, & lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax, & Hubbard_U, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, & - llondon, ts_vdw, lxdm, vdw_table_name, scal6, lon_rcut, vdw_isolated ) + vdw_corr, vdw_table_name, scal6, lon_rcut, vdw_isolated ) !! More DFT initializations + CALL set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw, lxdm ) CALL enforce_input_dft ( dft_name, .TRUE. ) IF ( dft_is_hybrid() ) THEN ecutvcut=ecutvcut*e2 From 71b828d30645e2aea44443e7422b0ac8b011370d Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sat, 22 Jun 2019 10:15:22 +0200 Subject: [PATCH 16/95] Some more I/O cleanup --- Modules/qexsd_copy.f90 | 71 ++++++++++++++++++++++++++++++++++- Modules/set_vdw_corr.f90 | 14 +++---- PW/src/pw_restart_new.f90 | 78 ++------------------------------------- PW/src/read_file_new.f90 | 27 ++++++++++---- 4 files changed, 99 insertions(+), 91 deletions(-) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index e9b2612868..eb34ef06f1 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -22,7 +22,8 @@ MODULE qexsd_copy PUBLIC:: qexsd_copy_geninfo, qexsd_copy_parallel_info, qexsd_copy_dim, & qexsd_copy_atomic_species, qexsd_copy_atomic_structure, & qexsd_copy_symmetry, qexsd_copy_algorithmic_info, & - qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure + qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure, & + qexsd_copy_efield ! CONTAINS !------------------------------------------------------------------------------- @@ -528,6 +529,7 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & END DO END SUBROUTINE qexsd_copy_band_structure ! + !----------------------------------------------------------------------- SUBROUTINE qexsd_copy_algorithmic_info ( algo_obj, & real_space, tqr, okvan, okpaw ) USE qes_types_module, ONLY: algorithmic_info_type @@ -541,5 +543,70 @@ SUBROUTINE qexsd_copy_algorithmic_info ( algo_obj, & okpaw = algo_obj%paw ! END SUBROUTINE qexsd_copy_algorithmic_info - + !----------------------------------------------------------------------- + ! + !--------------------------------------------------------------------------- + SUBROUTINE qexsd_copy_efield ( efield_obj, tefield, dipfield, edir, & + emaxpos, eopreg, eamp, gate, zgate, & + block_, block_1, block_2, block_height, relaxz ) + !--------------------------------------------------------------------------- + USE qes_types_module, ONLY: electric_field_type + IMPLICIT NONE + ! + TYPE ( electric_field_type),OPTIONAL, INTENT(IN) :: efield_obj + LOGICAL, INTENT(OUT) :: tefield, dipfield + INTEGER, INTENT(INOUT) :: edir + REAL(dp), INTENT(INOUT) :: emaxpos, eopreg, eamp, gate, zgate, & + block_, block_1, block_2, block_height, relaxz + ! + ! + tefield = .FALSE. + dipfield = .FALSE. + IF ( .NOT. PRESENT( efield_obj) ) RETURN + IF (TRIM(efield_obj%electric_potential) == 'sawtooth_potential') THEN + tefield = .TRUE. + IF ( efield_obj%dipole_correction_ispresent ) THEN + dipfield = efield_obj%dipole_correction + ELSE + dipfield = .FALSE. + END IF + IF ( efield_obj%electric_field_direction_ispresent ) THEN + edir = efield_obj%electric_field_direction + ELSE + edir = 3 + END IF + IF ( efield_obj%potential_max_position_ispresent ) THEN + emaxpos = efield_obj%potential_max_position + ELSE + emaxpos = 5d-1 + END IF + IF ( efield_obj%potential_decrease_width_ispresent ) THEN + eopreg = efield_obj%potential_decrease_width + ELSE + eopreg = 1.d-1 + END IF + IF ( efield_obj%electric_field_amplitude_ispresent ) THEN + eamp = efield_obj%electric_field_amplitude + ELSE + eamp = 1.d-3 + END IF + IF (efield_obj%gate_settings_ispresent) THEN + gate = efield_obj%gate_settings%use_gate + IF (efield_obj%gate_settings%zgate_ispresent) & + zgate = efield_obj%gate_settings%zgate + IF (efield_obj%gate_settings%relaxz_ispresent) & + relaxz = efield_obj%gate_settings%relaxz + IF (efield_obj%gate_settings%block_ispresent) & + block_ = efield_obj%gate_settings%block + IF (efield_obj%gate_settings%block_1_ispresent) & + block_1 = efield_obj%gate_settings%block_1 + IF (efield_obj%gate_settings%block_2_ispresent) & + block_2 = efield_obj%gate_settings%block_2 + IF (efield_obj%gate_settings%block_height_ispresent) & + block_height = efield_obj%gate_settings%block_height + END IF + END IF + ! + END SUBROUTINE qexsd_copy_efield + ! END MODULE qexsd_copy diff --git a/Modules/set_vdw_corr.f90 b/Modules/set_vdw_corr.f90 index d6c1dbebd9..8a084a78bd 100644 --- a/Modules/set_vdw_corr.f90 +++ b/Modules/set_vdw_corr.f90 @@ -6,11 +6,11 @@ ! or http://www.gnu.org/copyleft/gpl.txt . ! ! -SUBROUTINE set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw_, lxdm ) +SUBROUTINE set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw, lxdm ) ! IMPLICIT NONE CHARACTER(LEN=*), INTENT(in) :: vdw_corr - LOGICAL, INTENT(out) :: llondon, ldftd3, ts_vdw_, lxdm + LOGICAL, INTENT(out) :: llondon, ldftd3, ts_vdw, lxdm ! SELECT CASE( TRIM( vdw_corr ) ) ! @@ -18,35 +18,35 @@ SUBROUTINE set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw_, lxdm ) ! llondon= .TRUE. ldftd3 = .FALSE. - ts_vdw_= .FALSE. + ts_vdw = .FALSE. lxdm = .FALSE. ! CASE( 'grimme-d3', 'Grimme-D3', 'DFT-D3', 'dft-d3' ) ! ldftd3 = .TRUE. llondon= .FALSE. - ts_vdw_= .FALSE. + ts_vdw = .FALSE. lxdm = .FALSE. ! CASE( 'TS', 'ts', 'ts-vdw', 'ts-vdW', 'tkatchenko-scheffler' ) ! llondon= .FALSE. ldftd3 = .FALSE. - ts_vdw_= .TRUE. + ts_vdw = .TRUE. lxdm = .FALSE. ! CASE( 'XDM', 'xdm' ) ! llondon= .FALSE. ldftd3 = .FALSE. - ts_vdw_= .FALSE. + ts_vdw = .FALSE. lxdm = .TRUE. ! CASE DEFAULT ! llondon= .FALSE. ldftd3 = .FALSE. - ts_vdw_= .FALSE. + ts_vdw = .FALSE. lxdm = .FALSE. ! END SELECT diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index d6ea784ae3..9dc39c3dc9 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -42,8 +42,7 @@ MODULE pw_restart_new read_collected_to_evc PUBLIC :: readschema_ef, readschema_spin, readschema_magnetization, & readschema_occupations, readschema_brillouin_zone, & - readschema_band_structure, readschema_efield, & - readschema_outputPBC + readschema_band_structure ! CONTAINS !------------------------------------------------------------------------ @@ -1006,61 +1005,6 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g ! END SUBROUTINE pw_read_schema ! - !--------------------------------------------------------------------------- - SUBROUTINE readschema_efield( efield_obj ) - !--------------------------------------------------------------------------- - ! - USE extfield, ONLY : tefield, dipfield, edir, emaxpos, eopreg, eamp, gate, zgate, & - block, block_1, block_2, block_height, relaxz - ! - IMPLICIT NONE - ! - TYPE ( electric_field_type),OPTIONAL, INTENT(IN) :: efield_obj - ! - ! - tefield = .FALSE. - dipfield = .FALSE. - IF ( .NOT. PRESENT( efield_obj) ) RETURN - IF (TRIM(efield_obj%electric_potential) == 'sawtooth_potential') THEN - tefield = .TRUE. - IF ( efield_obj%dipole_correction_ispresent ) THEN - dipfield = efield_obj%dipole_correction - ELSE - dipfield = .FALSE. - END IF - IF ( efield_obj%electric_field_direction_ispresent ) THEN - edir = efield_obj%electric_field_direction - ELSE - edir = 3 - END IF - IF ( efield_obj%potential_max_position_ispresent ) THEN - emaxpos = efield_obj%potential_max_position - ELSE - emaxpos = 5d-1 - END IF - IF ( efield_obj%potential_decrease_width_ispresent ) THEN - eopreg = efield_obj%potential_decrease_width - ELSE - eopreg = 1.d-1 - END IF - IF ( efield_obj%electric_field_amplitude_ispresent ) THEN - eamp = efield_obj%electric_field_amplitude - ELSE - eamp = 1.d-3 - END IF - IF (efield_obj%gate_settings_ispresent) THEN - gate = efield_obj%gate_settings%use_gate - IF (efield_obj%gate_settings%zgate_ispresent) zgate = efield_obj%gate_settings%zgate - IF (efield_obj%gate_settings%relaxz_ispresent) relaxz = efield_obj%gate_settings%relaxz - IF (efield_obj%gate_settings%block_ispresent) block = efield_obj%gate_settings%block - IF (efield_obj%gate_settings%block_1_ispresent) block_1 = efield_obj%gate_settings%block_1 - IF (efield_obj%gate_settings%block_2_ispresent) block_2 = efield_obj%gate_settings%block_2 - IF (efield_obj%gate_settings%block_height_ispresent) & - block_height = efield_obj%gate_settings%block_height - END IF - END IF - ! - END SUBROUTINE readschema_efield !-------------------------------------------------------------------------- SUBROUTINE readschema_spin( magnetization_obj) !-------------------------------------------------------------------------- @@ -1161,25 +1105,9 @@ SUBROUTINE readschema_magnetization( band_structure_obj, atomic_specs_obj, magne END SUBROUTINE readschema_magnetization !----------------------------------------------------------------------- ! - ! --------- For 2D cutoff: to read the fact that 2D cutoff was used in scf from new xml---------------- - !----------------------------------------------------------------------------------------------------- - SUBROUTINE readschema_outputPBC( boundary_conditions_obj ) - !----------------------------------------------------------------------------------------------------- - ! - USE Coul_cut_2D, ONLY : do_cutoff_2D - ! - IMPLICIT NONE - ! - TYPE ( outputPBC_type ),INTENT(IN) :: boundary_conditions_obj - ! - IF ( TRIM(boundary_conditions_obj%assume_isolated) .EQ. "2D" ) THEN - do_cutoff_2D=.TRUE. - ENDIF - ! - END SUBROUTINE readschema_outputPBC - !----------------------------------------------------------------------------------------------------- + !--------------------------------------------------------------------------- SUBROUTINE readschema_brillouin_zone( band_structure ) - !----------------------------------------------------------------------------------------------------- + !--------------------------------------------------------------------------- ! USE lsda_mod, ONLY : lsda, isk USE klist, ONLY : nkstot, xk, wk diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index edbee61d72..859e2aea41 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -103,9 +103,12 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE ions_base, ONLY : nat, nsp, ityp, amass, atm, tau, extfor USE cell_base, ONLY : alat, at, bg, ibrav, celldm, omega USE force_mod, ONLY : force - USE klist, ONLY : nks, nkstot + USE klist, ONLY : nks, nkstot, nelec, wk + USE ener, ONLY : ef, ef_up, ef_dw USE wvfct, ONLY : npwx, nbnd, et, wg - USE extfield, ONLY : forcefield, tefield, gate, forcegate + USE extfield, ONLY : forcefield, forcegate, tefield, dipfield, & + edir, emaxpos, eopreg, eamp, el_dipole, ion_dipole, gate, zgate, & + relaxz, block, block_1, block_2, block_height USE io_files, ONLY : tmp_dir, prefix, postfix USE symm_base, ONLY : nrot, nsym, invsym, s, ft, irt, t_rev, & sname, inverse_s, s_axis_to_cart, & @@ -124,17 +127,19 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE exx, ONLY : ecutfock, local_thr USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, ldftd3, & lxdm, ts_vdw + USE Coul_cut_2D, ONLY : do_cutoff_2D USE noncollin_module,ONLY : noncolin USE spin_orb, ONLY : domag + USE lsda_mod, ONLY : isk, lsda USE realus, ONLY : real_space + USE basis, ONLY : natomwfc USE uspp, ONLY : okvan USE paw_variables, ONLY : okpaw ! USE pw_restart_new, ONLY : pw_read_schema, & readschema_spin, readschema_magnetization, & readschema_occupations, readschema_brillouin_zone, & - readschema_band_structure, readschema_efield, & - readschema_outputPBC + readschema_band_structure USE qes_types_module,ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset @@ -153,7 +158,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) IMPLICIT NONE LOGICAL, INTENT(OUT) :: wfc_is_collected ! - INTEGER :: i, is, ik, ibnd, nb, nt, ios, isym, ierr, dum1,dum2,dum3 + INTEGER :: i, is, ik, nbnd_up, nbnd_dw, ierr, dum1,dum2,dum3 LOGICAL :: magnetic_sym, lvalid_input CHARACTER(LEN=20) :: dft_name, vdw_corr REAL(dp) :: exx_fraction, screening_parameter @@ -255,6 +260,10 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL set_screening_parameter ( screening_parameter ) CALL start_exx () END IF + !! Band structure section + !!CALL qexsd_copy_band_structure( output_obj%band_structure, lsda, & + !! nkstot, isk, natomwfc, nbnd_up, nbnd_dw, nelec, wk, wg, & + !! ef, ef_up, ef_dw, et ) !! CALL readschema_spin( output_obj%magnetization ) CALL readschema_magnetization ( output_obj%band_structure, & @@ -267,7 +276,11 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL qexsd_copy_symmetry ( output_obj%symmetries, & nsym, nrot, s, ft, sname, t_rev, invsym, irt, & noinv, nosym, no_t_rev, input_obj%symmetry_flags ) - CALL readschema_efield ( input_obj%electric_field ) + + CALL qexsd_copy_efield ( input_obj%electric_field, & + tefield, dipfield, edir, emaxpos, eopreg, eamp, & + gate, zgate, block, block_1, block_2, block_height, relaxz ) + ELSE CALL qexsd_copy_symmetry ( output_obj%symmetries, & nsym, nrot, s, ft, sname, t_rev, invsym, irt, & @@ -281,7 +294,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) !! symmetry check - FIXME: is this needed? IF (nat > 0) CALL checkallsym( nat, tau, ityp) ! - CALL readschema_outputPBC ( output_obj%boundary_conditions) + do_cutoff_2D = (output_obj%boundary_conditions%assume_isolated == "2D") CALL qexsd_copy_algorithmic_info ( output_obj%algorithmic_info, & real_space, tqr, okvan, okpaw ) ! From 9bda6a81a340cdb684110a2456984b7c0362ed0b Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sat, 22 Jun 2019 12:06:58 +0200 Subject: [PATCH 17/95] More I/O cleanup, fix to previous commit --- Modules/qexsd_copy.f90 | 26 +++++++++++++++++++---- PW/src/pw_restart_new.f90 | 43 ++++++++++++++------------------------- PW/src/read_file_new.f90 | 7 ++++--- 3 files changed, 41 insertions(+), 35 deletions(-) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index eb34ef06f1..624cbfcc20 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -101,7 +101,7 @@ END SUBROUTINE qexsd_copy_dim ! !-------------------------------------------------------------------------- SUBROUTINE qexsd_copy_atomic_species (atomic_species, nsp, atm, amass, & - psfile, pseudo_dir) + starting_magnetization, angle1, angle2, psfile, pseudo_dir) !--------------------------------------------------------------------------- ! USE qes_types_module, ONLY : atomic_species_type ! @@ -110,8 +110,10 @@ SUBROUTINE qexsd_copy_atomic_species (atomic_species, nsp, atm, amass, & TYPE ( atomic_species_type ),INTENT(IN) :: atomic_species INTEGER, INTENT(out) :: nsp CHARACTER(LEN=*), INTENT(out) :: atm(:) - CHARACTER(LEN=*), OPTIONAL, INTENT(out) :: psfile(:), pseudo_dir REAL(dp), INTENT(out) :: amass(:) + REAL(dp), OPTIONAL, INTENT(out) :: starting_magnetization(:), & + angle1(:), angle2(:) + CHARACTER(LEN=*), OPTIONAL, INTENT(out) :: psfile(:), pseudo_dir ! INTEGER :: isp ! @@ -124,6 +126,21 @@ SUBROUTINE qexsd_copy_atomic_species (atomic_species, nsp, atm, amass, & IF ( PRESENT (psfile) ) THEN psfile(isp) = TRIM ( atomic_species%species(isp)%pseudo_file) END IF + IF ( PRESENT (starting_magnetization) ) THEN + IF ( atomic_species%species(isp)%starting_magnetization_ispresent) THEN + starting_magnetization(isp) = atomic_species%species(isp)%starting_magnetization + END IF + END IF + IF ( PRESENT (angle1) ) THEN + IF ( atomic_species%species(isp)%spin_teta_ispresent ) THEN + angle1(isp) = atomic_species%species(isp)%spin_teta + END IF + END IF + IF ( PRESENT (angle2) ) THEN + IF ( atomic_species%species(isp)%spin_phi_ispresent ) THEN + angle2(isp) = atomic_species%species(isp)%spin_phi + END IF + END IF END DO ! ! ... this is where PP files were originally found (if available) @@ -556,8 +573,9 @@ SUBROUTINE qexsd_copy_efield ( efield_obj, tefield, dipfield, edir, & TYPE ( electric_field_type),OPTIONAL, INTENT(IN) :: efield_obj LOGICAL, INTENT(OUT) :: tefield, dipfield INTEGER, INTENT(INOUT) :: edir - REAL(dp), INTENT(INOUT) :: emaxpos, eopreg, eamp, gate, zgate, & - block_, block_1, block_2, block_height, relaxz + LOGICAL, INTENT(INOUT) :: gate, block_, relaxz + REAL(dp), INTENT(INOUT) :: emaxpos, eopreg, eamp, & + zgate, block_1, block_2, block_height ! ! tefield = .FALSE. diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 9dc39c3dc9..dd01e978a8 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -1056,7 +1056,7 @@ SUBROUTINE readschema_magnetization( band_structure_obj, atomic_specs_obj, magne TYPE ( magnetization_type ) ,INTENT(IN) :: magnetization_obj ! REAL(DP) :: tot_mag_, nelec_, theta, phi, fixed_magnetization(3) - INTEGER :: nsp_, isp + INTEGER :: isp ! bfield = 0.d0 nelec_ = band_structure_obj%nelec @@ -1069,38 +1069,25 @@ SUBROUTINE readschema_magnetization( band_structure_obj, atomic_specs_obj, magne CALL set_nelup_neldw(tot_magnetization, nelec_, nelup, neldw) END IF END IF - nsp_ = atomic_specs_obj%ntyp - ! + ! FIXME: doesn't belong here and doesn't work because i_cons is set to 0 i_cons = 0 - DO isp = 1, nsp_ - IF ( atomic_specs_obj%species(isp)%starting_magnetization_ispresent) THEN - starting_magnetization(isp) = atomic_specs_obj%species(isp)%starting_magnetization - END IF - ! - IF ( band_structure_obj%noncolin ) THEN - IF ( atomic_specs_obj%species(isp)%spin_teta_ispresent ) THEN - theta = atomic_specs_obj%species(isp)%spin_teta - angle1(isp) = theta - END IF - IF ( atomic_specs_obj%species(isp)%spin_phi_ispresent ) THEN - phi = atomic_specs_obj%species(isp)%spin_phi - angle2(isp) = phi - END IF - ! + DO isp = 1, atomic_specs_obj%ntyp + IF ( band_structure_obj%noncolin ) THEN + angle1(isp) = theta + angle2(isp) = phi IF ( atomic_specs_obj%species(isp)%starting_magnetization_ispresent .AND. & - i_cons == 1 ) THEN - ! - mcons(1,isp) = starting_magnetization(isp) * sin( theta ) * cos( phi ) - mcons(2,isp) = starting_magnetization(isp) * sin( theta ) * sin( phi ) - mcons(3,isp) = starting_magnetization(isp) * cos( theta ) + i_cons == 1 ) THEN + mcons(1,isp) = starting_magnetization(isp) * sin(angle1(isp)) * cos(angle2(isp)) + mcons(2,isp) = starting_magnetization(isp) * sin(angle1(isp)) * sin(angle2(isp)) + mcons(3,isp) = starting_magnetization(isp) * cos(angle1(isp)) ELSE IF ( i_cons == 2) THEN - mcons(3,isp) = cos(theta) + mcons(3,isp) = cos(angle1(isp)) END IF ELSE IF ( atomic_specs_obj%species(isp)%starting_magnetization_ispresent .AND. & - i_cons == 1 ) THEN - mcons(1,isp) = starting_magnetization(isp) - END IF - END DO + i_cons == 1 ) THEN + mcons(1,isp) = starting_magnetization(isp) + END IF + END DO ! END SUBROUTINE readschema_magnetization !----------------------------------------------------------------------- diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 859e2aea41..3f1880687d 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -128,9 +128,9 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, ldftd3, & lxdm, ts_vdw USE Coul_cut_2D, ONLY : do_cutoff_2D - USE noncollin_module,ONLY : noncolin + USE noncollin_module,ONLY : noncolin, angle1, angle2 USE spin_orb, ONLY : domag - USE lsda_mod, ONLY : isk, lsda + USE lsda_mod, ONLY : isk, lsda, starting_magnetization USE realus, ONLY : real_space USE basis, ONLY : natomwfc USE uspp, ONLY : okvan @@ -220,7 +220,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! pseudo_dir_cur = TRIM( tmp_dir ) // TRIM( prefix ) // postfix CALL qexsd_copy_atomic_species ( output_obj%atomic_species, & - nsp, atm, amass, psfile, pseudo_dir ) + nsp, atm, amass, angle1, angle2, starting_magnetization, & + psfile, pseudo_dir ) IF ( pseudo_dir == ' ' ) pseudo_dir=pseudo_dir_cur !! Atomic structure section CALL qexsd_copy_atomic_structure (output_obj%atomic_structure, nsp, & From 0b0d98d61f6c45be50021d8b83b5fe5104ab5c12 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sat, 22 Jun 2019 12:45:19 +0200 Subject: [PATCH 18/95] Forgotten commit --- PW/src/read_conf_from_file.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PW/src/read_conf_from_file.f90 b/PW/src/read_conf_from_file.f90 index 7f12796189..6b2bfb323a 100644 --- a/PW/src/read_conf_from_file.f90 +++ b/PW/src/read_conf_from_file.f90 @@ -44,7 +44,7 @@ FUNCTION read_config_from_file(nat, at_old, omega_old, lmovecell, at, bg, & CALL pw_read_schema ( ierr, output_obj ) IF (ierr == 0 ) THEN CALL qexsd_copy_atomic_species ( output_obj%atomic_species, & - nsp, atm, amass, psfile, pseudo_dir ) + nsp, atm, amass, PSFILE=psfile, PSEUDO_DIR=pseudo_dir ) IF ( pseudo_dir == ' ' ) pseudo_dir=pseudo_dir_cur CALL qexsd_copy_atomic_structure (output_obj%atomic_structure, nsp, & atm, nat_, tau, ityp, alat, at(:,1), at(:,2), at(:,3), ibrav ) From baff6b1bf06d590ceedf687b2e20ac21c6181fb6 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sat, 22 Jun 2019 13:10:40 +0200 Subject: [PATCH 19/95] Yet another compilation problem fixed --- PW/src/read_file_new.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 3f1880687d..cea2c87192 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -147,7 +147,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) qexsd_copy_dim, qexsd_copy_atomic_species, & qexsd_copy_atomic_structure, qexsd_copy_symmetry, & qexsd_copy_basis_set, qexsd_copy_algorithmic_info,& - qexsd_copy_dft + qexsd_copy_dft, qexsd_copy_efield #if defined(__BEOWULF) USE qes_bcast_module,ONLY : qes_bcast From c80f3c54d96aa0c710f2b6a803b86e0736a3e7be Mon Sep 17 00:00:00 2001 From: giannozz Date: Sat, 22 Jun 2019 20:33:30 +0000 Subject: [PATCH 20/95] More xml I/O cleanup --- Modules/qexsd_copy.f90 | 93 +++++++++++++++++++++++-- Modules/set_vdw_corr.f90 | 14 ++-- PW/src/pw_restart_new.f90 | 121 +++++---------------------------- PW/src/read_conf_from_file.f90 | 2 +- PW/src/read_file_new.f90 | 34 ++++++--- 5 files changed, 139 insertions(+), 125 deletions(-) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index e9b2612868..624cbfcc20 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -22,7 +22,8 @@ MODULE qexsd_copy PUBLIC:: qexsd_copy_geninfo, qexsd_copy_parallel_info, qexsd_copy_dim, & qexsd_copy_atomic_species, qexsd_copy_atomic_structure, & qexsd_copy_symmetry, qexsd_copy_algorithmic_info, & - qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure + qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure, & + qexsd_copy_efield ! CONTAINS !------------------------------------------------------------------------------- @@ -100,7 +101,7 @@ END SUBROUTINE qexsd_copy_dim ! !-------------------------------------------------------------------------- SUBROUTINE qexsd_copy_atomic_species (atomic_species, nsp, atm, amass, & - psfile, pseudo_dir) + starting_magnetization, angle1, angle2, psfile, pseudo_dir) !--------------------------------------------------------------------------- ! USE qes_types_module, ONLY : atomic_species_type ! @@ -109,8 +110,10 @@ SUBROUTINE qexsd_copy_atomic_species (atomic_species, nsp, atm, amass, & TYPE ( atomic_species_type ),INTENT(IN) :: atomic_species INTEGER, INTENT(out) :: nsp CHARACTER(LEN=*), INTENT(out) :: atm(:) - CHARACTER(LEN=*), OPTIONAL, INTENT(out) :: psfile(:), pseudo_dir REAL(dp), INTENT(out) :: amass(:) + REAL(dp), OPTIONAL, INTENT(out) :: starting_magnetization(:), & + angle1(:), angle2(:) + CHARACTER(LEN=*), OPTIONAL, INTENT(out) :: psfile(:), pseudo_dir ! INTEGER :: isp ! @@ -123,6 +126,21 @@ SUBROUTINE qexsd_copy_atomic_species (atomic_species, nsp, atm, amass, & IF ( PRESENT (psfile) ) THEN psfile(isp) = TRIM ( atomic_species%species(isp)%pseudo_file) END IF + IF ( PRESENT (starting_magnetization) ) THEN + IF ( atomic_species%species(isp)%starting_magnetization_ispresent) THEN + starting_magnetization(isp) = atomic_species%species(isp)%starting_magnetization + END IF + END IF + IF ( PRESENT (angle1) ) THEN + IF ( atomic_species%species(isp)%spin_teta_ispresent ) THEN + angle1(isp) = atomic_species%species(isp)%spin_teta + END IF + END IF + IF ( PRESENT (angle2) ) THEN + IF ( atomic_species%species(isp)%spin_phi_ispresent ) THEN + angle2(isp) = atomic_species%species(isp)%spin_phi + END IF + END IF END DO ! ! ... this is where PP files were originally found (if available) @@ -528,6 +546,7 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & END DO END SUBROUTINE qexsd_copy_band_structure ! + !----------------------------------------------------------------------- SUBROUTINE qexsd_copy_algorithmic_info ( algo_obj, & real_space, tqr, okvan, okpaw ) USE qes_types_module, ONLY: algorithmic_info_type @@ -541,5 +560,71 @@ SUBROUTINE qexsd_copy_algorithmic_info ( algo_obj, & okpaw = algo_obj%paw ! END SUBROUTINE qexsd_copy_algorithmic_info - + !----------------------------------------------------------------------- + ! + !--------------------------------------------------------------------------- + SUBROUTINE qexsd_copy_efield ( efield_obj, tefield, dipfield, edir, & + emaxpos, eopreg, eamp, gate, zgate, & + block_, block_1, block_2, block_height, relaxz ) + !--------------------------------------------------------------------------- + USE qes_types_module, ONLY: electric_field_type + IMPLICIT NONE + ! + TYPE ( electric_field_type),OPTIONAL, INTENT(IN) :: efield_obj + LOGICAL, INTENT(OUT) :: tefield, dipfield + INTEGER, INTENT(INOUT) :: edir + LOGICAL, INTENT(INOUT) :: gate, block_, relaxz + REAL(dp), INTENT(INOUT) :: emaxpos, eopreg, eamp, & + zgate, block_1, block_2, block_height + ! + ! + tefield = .FALSE. + dipfield = .FALSE. + IF ( .NOT. PRESENT( efield_obj) ) RETURN + IF (TRIM(efield_obj%electric_potential) == 'sawtooth_potential') THEN + tefield = .TRUE. + IF ( efield_obj%dipole_correction_ispresent ) THEN + dipfield = efield_obj%dipole_correction + ELSE + dipfield = .FALSE. + END IF + IF ( efield_obj%electric_field_direction_ispresent ) THEN + edir = efield_obj%electric_field_direction + ELSE + edir = 3 + END IF + IF ( efield_obj%potential_max_position_ispresent ) THEN + emaxpos = efield_obj%potential_max_position + ELSE + emaxpos = 5d-1 + END IF + IF ( efield_obj%potential_decrease_width_ispresent ) THEN + eopreg = efield_obj%potential_decrease_width + ELSE + eopreg = 1.d-1 + END IF + IF ( efield_obj%electric_field_amplitude_ispresent ) THEN + eamp = efield_obj%electric_field_amplitude + ELSE + eamp = 1.d-3 + END IF + IF (efield_obj%gate_settings_ispresent) THEN + gate = efield_obj%gate_settings%use_gate + IF (efield_obj%gate_settings%zgate_ispresent) & + zgate = efield_obj%gate_settings%zgate + IF (efield_obj%gate_settings%relaxz_ispresent) & + relaxz = efield_obj%gate_settings%relaxz + IF (efield_obj%gate_settings%block_ispresent) & + block_ = efield_obj%gate_settings%block + IF (efield_obj%gate_settings%block_1_ispresent) & + block_1 = efield_obj%gate_settings%block_1 + IF (efield_obj%gate_settings%block_2_ispresent) & + block_2 = efield_obj%gate_settings%block_2 + IF (efield_obj%gate_settings%block_height_ispresent) & + block_height = efield_obj%gate_settings%block_height + END IF + END IF + ! + END SUBROUTINE qexsd_copy_efield + ! END MODULE qexsd_copy diff --git a/Modules/set_vdw_corr.f90 b/Modules/set_vdw_corr.f90 index d6c1dbebd9..8a084a78bd 100644 --- a/Modules/set_vdw_corr.f90 +++ b/Modules/set_vdw_corr.f90 @@ -6,11 +6,11 @@ ! or http://www.gnu.org/copyleft/gpl.txt . ! ! -SUBROUTINE set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw_, lxdm ) +SUBROUTINE set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw, lxdm ) ! IMPLICIT NONE CHARACTER(LEN=*), INTENT(in) :: vdw_corr - LOGICAL, INTENT(out) :: llondon, ldftd3, ts_vdw_, lxdm + LOGICAL, INTENT(out) :: llondon, ldftd3, ts_vdw, lxdm ! SELECT CASE( TRIM( vdw_corr ) ) ! @@ -18,35 +18,35 @@ SUBROUTINE set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw_, lxdm ) ! llondon= .TRUE. ldftd3 = .FALSE. - ts_vdw_= .FALSE. + ts_vdw = .FALSE. lxdm = .FALSE. ! CASE( 'grimme-d3', 'Grimme-D3', 'DFT-D3', 'dft-d3' ) ! ldftd3 = .TRUE. llondon= .FALSE. - ts_vdw_= .FALSE. + ts_vdw = .FALSE. lxdm = .FALSE. ! CASE( 'TS', 'ts', 'ts-vdw', 'ts-vdW', 'tkatchenko-scheffler' ) ! llondon= .FALSE. ldftd3 = .FALSE. - ts_vdw_= .TRUE. + ts_vdw = .TRUE. lxdm = .FALSE. ! CASE( 'XDM', 'xdm' ) ! llondon= .FALSE. ldftd3 = .FALSE. - ts_vdw_= .FALSE. + ts_vdw = .FALSE. lxdm = .TRUE. ! CASE DEFAULT ! llondon= .FALSE. ldftd3 = .FALSE. - ts_vdw_= .FALSE. + ts_vdw = .FALSE. lxdm = .FALSE. ! END SELECT diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index d6ea784ae3..dd01e978a8 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -42,8 +42,7 @@ MODULE pw_restart_new read_collected_to_evc PUBLIC :: readschema_ef, readschema_spin, readschema_magnetization, & readschema_occupations, readschema_brillouin_zone, & - readschema_band_structure, readschema_efield, & - readschema_outputPBC + readschema_band_structure ! CONTAINS !------------------------------------------------------------------------ @@ -1006,61 +1005,6 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g ! END SUBROUTINE pw_read_schema ! - !--------------------------------------------------------------------------- - SUBROUTINE readschema_efield( efield_obj ) - !--------------------------------------------------------------------------- - ! - USE extfield, ONLY : tefield, dipfield, edir, emaxpos, eopreg, eamp, gate, zgate, & - block, block_1, block_2, block_height, relaxz - ! - IMPLICIT NONE - ! - TYPE ( electric_field_type),OPTIONAL, INTENT(IN) :: efield_obj - ! - ! - tefield = .FALSE. - dipfield = .FALSE. - IF ( .NOT. PRESENT( efield_obj) ) RETURN - IF (TRIM(efield_obj%electric_potential) == 'sawtooth_potential') THEN - tefield = .TRUE. - IF ( efield_obj%dipole_correction_ispresent ) THEN - dipfield = efield_obj%dipole_correction - ELSE - dipfield = .FALSE. - END IF - IF ( efield_obj%electric_field_direction_ispresent ) THEN - edir = efield_obj%electric_field_direction - ELSE - edir = 3 - END IF - IF ( efield_obj%potential_max_position_ispresent ) THEN - emaxpos = efield_obj%potential_max_position - ELSE - emaxpos = 5d-1 - END IF - IF ( efield_obj%potential_decrease_width_ispresent ) THEN - eopreg = efield_obj%potential_decrease_width - ELSE - eopreg = 1.d-1 - END IF - IF ( efield_obj%electric_field_amplitude_ispresent ) THEN - eamp = efield_obj%electric_field_amplitude - ELSE - eamp = 1.d-3 - END IF - IF (efield_obj%gate_settings_ispresent) THEN - gate = efield_obj%gate_settings%use_gate - IF (efield_obj%gate_settings%zgate_ispresent) zgate = efield_obj%gate_settings%zgate - IF (efield_obj%gate_settings%relaxz_ispresent) relaxz = efield_obj%gate_settings%relaxz - IF (efield_obj%gate_settings%block_ispresent) block = efield_obj%gate_settings%block - IF (efield_obj%gate_settings%block_1_ispresent) block_1 = efield_obj%gate_settings%block_1 - IF (efield_obj%gate_settings%block_2_ispresent) block_2 = efield_obj%gate_settings%block_2 - IF (efield_obj%gate_settings%block_height_ispresent) & - block_height = efield_obj%gate_settings%block_height - END IF - END IF - ! - END SUBROUTINE readschema_efield !-------------------------------------------------------------------------- SUBROUTINE readschema_spin( magnetization_obj) !-------------------------------------------------------------------------- @@ -1112,7 +1056,7 @@ SUBROUTINE readschema_magnetization( band_structure_obj, atomic_specs_obj, magne TYPE ( magnetization_type ) ,INTENT(IN) :: magnetization_obj ! REAL(DP) :: tot_mag_, nelec_, theta, phi, fixed_magnetization(3) - INTEGER :: nsp_, isp + INTEGER :: isp ! bfield = 0.d0 nelec_ = band_structure_obj%nelec @@ -1125,61 +1069,32 @@ SUBROUTINE readschema_magnetization( band_structure_obj, atomic_specs_obj, magne CALL set_nelup_neldw(tot_magnetization, nelec_, nelup, neldw) END IF END IF - nsp_ = atomic_specs_obj%ntyp - ! + ! FIXME: doesn't belong here and doesn't work because i_cons is set to 0 i_cons = 0 - DO isp = 1, nsp_ - IF ( atomic_specs_obj%species(isp)%starting_magnetization_ispresent) THEN - starting_magnetization(isp) = atomic_specs_obj%species(isp)%starting_magnetization - END IF - ! - IF ( band_structure_obj%noncolin ) THEN - IF ( atomic_specs_obj%species(isp)%spin_teta_ispresent ) THEN - theta = atomic_specs_obj%species(isp)%spin_teta - angle1(isp) = theta - END IF - IF ( atomic_specs_obj%species(isp)%spin_phi_ispresent ) THEN - phi = atomic_specs_obj%species(isp)%spin_phi - angle2(isp) = phi - END IF - ! + DO isp = 1, atomic_specs_obj%ntyp + IF ( band_structure_obj%noncolin ) THEN + angle1(isp) = theta + angle2(isp) = phi IF ( atomic_specs_obj%species(isp)%starting_magnetization_ispresent .AND. & - i_cons == 1 ) THEN - ! - mcons(1,isp) = starting_magnetization(isp) * sin( theta ) * cos( phi ) - mcons(2,isp) = starting_magnetization(isp) * sin( theta ) * sin( phi ) - mcons(3,isp) = starting_magnetization(isp) * cos( theta ) + i_cons == 1 ) THEN + mcons(1,isp) = starting_magnetization(isp) * sin(angle1(isp)) * cos(angle2(isp)) + mcons(2,isp) = starting_magnetization(isp) * sin(angle1(isp)) * sin(angle2(isp)) + mcons(3,isp) = starting_magnetization(isp) * cos(angle1(isp)) ELSE IF ( i_cons == 2) THEN - mcons(3,isp) = cos(theta) + mcons(3,isp) = cos(angle1(isp)) END IF ELSE IF ( atomic_specs_obj%species(isp)%starting_magnetization_ispresent .AND. & - i_cons == 1 ) THEN - mcons(1,isp) = starting_magnetization(isp) - END IF - END DO + i_cons == 1 ) THEN + mcons(1,isp) = starting_magnetization(isp) + END IF + END DO ! END SUBROUTINE readschema_magnetization !----------------------------------------------------------------------- ! - ! --------- For 2D cutoff: to read the fact that 2D cutoff was used in scf from new xml---------------- - !----------------------------------------------------------------------------------------------------- - SUBROUTINE readschema_outputPBC( boundary_conditions_obj ) - !----------------------------------------------------------------------------------------------------- - ! - USE Coul_cut_2D, ONLY : do_cutoff_2D - ! - IMPLICIT NONE - ! - TYPE ( outputPBC_type ),INTENT(IN) :: boundary_conditions_obj - ! - IF ( TRIM(boundary_conditions_obj%assume_isolated) .EQ. "2D" ) THEN - do_cutoff_2D=.TRUE. - ENDIF - ! - END SUBROUTINE readschema_outputPBC - !----------------------------------------------------------------------------------------------------- + !--------------------------------------------------------------------------- SUBROUTINE readschema_brillouin_zone( band_structure ) - !----------------------------------------------------------------------------------------------------- + !--------------------------------------------------------------------------- ! USE lsda_mod, ONLY : lsda, isk USE klist, ONLY : nkstot, xk, wk diff --git a/PW/src/read_conf_from_file.f90 b/PW/src/read_conf_from_file.f90 index 7f12796189..6b2bfb323a 100644 --- a/PW/src/read_conf_from_file.f90 +++ b/PW/src/read_conf_from_file.f90 @@ -44,7 +44,7 @@ FUNCTION read_config_from_file(nat, at_old, omega_old, lmovecell, at, bg, & CALL pw_read_schema ( ierr, output_obj ) IF (ierr == 0 ) THEN CALL qexsd_copy_atomic_species ( output_obj%atomic_species, & - nsp, atm, amass, psfile, pseudo_dir ) + nsp, atm, amass, PSFILE=psfile, PSEUDO_DIR=pseudo_dir ) IF ( pseudo_dir == ' ' ) pseudo_dir=pseudo_dir_cur CALL qexsd_copy_atomic_structure (output_obj%atomic_structure, nsp, & atm, nat_, tau, ityp, alat, at(:,1), at(:,2), at(:,3), ibrav ) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index edbee61d72..cea2c87192 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -103,9 +103,12 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE ions_base, ONLY : nat, nsp, ityp, amass, atm, tau, extfor USE cell_base, ONLY : alat, at, bg, ibrav, celldm, omega USE force_mod, ONLY : force - USE klist, ONLY : nks, nkstot + USE klist, ONLY : nks, nkstot, nelec, wk + USE ener, ONLY : ef, ef_up, ef_dw USE wvfct, ONLY : npwx, nbnd, et, wg - USE extfield, ONLY : forcefield, tefield, gate, forcegate + USE extfield, ONLY : forcefield, forcegate, tefield, dipfield, & + edir, emaxpos, eopreg, eamp, el_dipole, ion_dipole, gate, zgate, & + relaxz, block, block_1, block_2, block_height USE io_files, ONLY : tmp_dir, prefix, postfix USE symm_base, ONLY : nrot, nsym, invsym, s, ft, irt, t_rev, & sname, inverse_s, s_axis_to_cart, & @@ -124,17 +127,19 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE exx, ONLY : ecutfock, local_thr USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, ldftd3, & lxdm, ts_vdw - USE noncollin_module,ONLY : noncolin + USE Coul_cut_2D, ONLY : do_cutoff_2D + USE noncollin_module,ONLY : noncolin, angle1, angle2 USE spin_orb, ONLY : domag + USE lsda_mod, ONLY : isk, lsda, starting_magnetization USE realus, ONLY : real_space + USE basis, ONLY : natomwfc USE uspp, ONLY : okvan USE paw_variables, ONLY : okpaw ! USE pw_restart_new, ONLY : pw_read_schema, & readschema_spin, readschema_magnetization, & readschema_occupations, readschema_brillouin_zone, & - readschema_band_structure, readschema_efield, & - readschema_outputPBC + readschema_band_structure USE qes_types_module,ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset @@ -142,7 +147,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) qexsd_copy_dim, qexsd_copy_atomic_species, & qexsd_copy_atomic_structure, qexsd_copy_symmetry, & qexsd_copy_basis_set, qexsd_copy_algorithmic_info,& - qexsd_copy_dft + qexsd_copy_dft, qexsd_copy_efield #if defined(__BEOWULF) USE qes_bcast_module,ONLY : qes_bcast @@ -153,7 +158,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) IMPLICIT NONE LOGICAL, INTENT(OUT) :: wfc_is_collected ! - INTEGER :: i, is, ik, ibnd, nb, nt, ios, isym, ierr, dum1,dum2,dum3 + INTEGER :: i, is, ik, nbnd_up, nbnd_dw, ierr, dum1,dum2,dum3 LOGICAL :: magnetic_sym, lvalid_input CHARACTER(LEN=20) :: dft_name, vdw_corr REAL(dp) :: exx_fraction, screening_parameter @@ -215,7 +220,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! pseudo_dir_cur = TRIM( tmp_dir ) // TRIM( prefix ) // postfix CALL qexsd_copy_atomic_species ( output_obj%atomic_species, & - nsp, atm, amass, psfile, pseudo_dir ) + nsp, atm, amass, angle1, angle2, starting_magnetization, & + psfile, pseudo_dir ) IF ( pseudo_dir == ' ' ) pseudo_dir=pseudo_dir_cur !! Atomic structure section CALL qexsd_copy_atomic_structure (output_obj%atomic_structure, nsp, & @@ -255,6 +261,10 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL set_screening_parameter ( screening_parameter ) CALL start_exx () END IF + !! Band structure section + !!CALL qexsd_copy_band_structure( output_obj%band_structure, lsda, & + !! nkstot, isk, natomwfc, nbnd_up, nbnd_dw, nelec, wk, wg, & + !! ef, ef_up, ef_dw, et ) !! CALL readschema_spin( output_obj%magnetization ) CALL readschema_magnetization ( output_obj%band_structure, & @@ -267,7 +277,11 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL qexsd_copy_symmetry ( output_obj%symmetries, & nsym, nrot, s, ft, sname, t_rev, invsym, irt, & noinv, nosym, no_t_rev, input_obj%symmetry_flags ) - CALL readschema_efield ( input_obj%electric_field ) + + CALL qexsd_copy_efield ( input_obj%electric_field, & + tefield, dipfield, edir, emaxpos, eopreg, eamp, & + gate, zgate, block, block_1, block_2, block_height, relaxz ) + ELSE CALL qexsd_copy_symmetry ( output_obj%symmetries, & nsym, nrot, s, ft, sname, t_rev, invsym, irt, & @@ -281,7 +295,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) !! symmetry check - FIXME: is this needed? IF (nat > 0) CALL checkallsym( nat, tau, ityp) ! - CALL readschema_outputPBC ( output_obj%boundary_conditions) + do_cutoff_2D = (output_obj%boundary_conditions%assume_isolated == "2D") CALL qexsd_copy_algorithmic_info ( output_obj%algorithmic_info, & real_space, tqr, okvan, okpaw ) ! From 466fa5acc423c068644413cd30c19ca30e6b6591 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sun, 23 Jun 2019 17:48:43 +0200 Subject: [PATCH 21/95] More xml I/O cleanup --- PW/src/pw_restart_new.f90 | 74 ++++++++++----------------------------- PW/src/read_file_new.f90 | 5 ++- 2 files changed, 20 insertions(+), 59 deletions(-) diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index dd01e978a8..54b4fff6e7 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -40,7 +40,7 @@ MODULE pw_restart_new PRIVATE PUBLIC :: pw_write_schema, pw_write_binaries, pw_read_schema, & read_collected_to_evc - PUBLIC :: readschema_ef, readschema_spin, readschema_magnetization, & + PUBLIC :: readschema_ef, readschema_magnetization, & readschema_occupations, readschema_brillouin_zone, & readschema_band_structure ! @@ -1005,25 +1005,29 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g ! END SUBROUTINE pw_read_schema ! - !-------------------------------------------------------------------------- - SUBROUTINE readschema_spin( magnetization_obj) - !-------------------------------------------------------------------------- + !----------------------------------------------------------------------------------------- + SUBROUTINE readschema_magnetization( band_structure_obj, magnetization_obj ) + !--------------------------------------------------------------------------------------- ! + USE klist, ONLY : two_fermi_energies, nelup, neldw, tot_magnetization + USE ener, ONLY : ef_up, ef_dw + USE lsda_mod, ONLY : nspin, lsda, starting_magnetization + USE noncollin_module, ONLY : noncolin, npol, bfield + USE electrons_base, ONLY : set_nelup_neldw USE spin_orb, ONLY : lspinorb, domag - USE lsda_mod, ONLY : nspin, lsda - USE noncollin_module, ONLY : noncolin, npol - USE qes_types_module, ONLY : magnetization_type - USE symm_base, ONLY : time_reversal - ! + USE qes_types_module, ONLY : band_structure_type, magnetization_type + ! IMPLICIT NONE + ! + TYPE ( band_structure_type ),INTENT(IN) :: band_structure_obj + TYPE ( magnetization_type ) ,INTENT(IN) :: magnetization_obj + REAL(dp) :: nelec_ ! - TYPE ( magnetization_type ),INTENT(IN) :: magnetization_obj - ! - lspinorb = magnetization_obj%spinorbit - domag = magnetization_obj%do_magnetization lsda = magnetization_obj%lsda noncolin = magnetization_obj%noncolin - IF ( noncolin .AND. domag ) time_reversal = .FALSE. + lspinorb = magnetization_obj%spinorbit + domag = magnetization_obj%do_magnetization + ! IF ( lsda ) THEN nspin = 2 npol = 1 @@ -1034,29 +1038,6 @@ SUBROUTINE readschema_spin( magnetization_obj) nspin =1 npol = 1 END IF - ! - END SUBROUTINE readschema_spin - ! - !----------------------------------------------------------------------------------------- - SUBROUTINE readschema_magnetization( band_structure_obj, atomic_specs_obj, magnetization_obj ) - !--------------------------------------------------------------------------------------- - ! - USE klist, ONLY : two_fermi_energies, nelup, neldw, tot_magnetization - USE ener, ONLY : ef_up, ef_dw - USE lsda_mod, ONLY : starting_magnetization - USE noncollin_module, ONLY : angle1, angle2, i_cons, mcons, bfield, & - lambda - USE electrons_base, ONLY : set_nelup_neldw - USE qes_types_module, ONLY : band_structure_type, atomic_species_type, input_type - ! - IMPLICIT NONE - ! - TYPE ( band_structure_type ),INTENT(IN) :: band_structure_obj - TYPE ( atomic_species_type ),INTENT(IN) :: atomic_specs_obj - TYPE ( magnetization_type ) ,INTENT(IN) :: magnetization_obj - ! - REAL(DP) :: tot_mag_, nelec_, theta, phi, fixed_magnetization(3) - INTEGER :: isp ! bfield = 0.d0 nelec_ = band_structure_obj%nelec @@ -1069,25 +1050,6 @@ SUBROUTINE readschema_magnetization( band_structure_obj, atomic_specs_obj, magne CALL set_nelup_neldw(tot_magnetization, nelec_, nelup, neldw) END IF END IF - ! FIXME: doesn't belong here and doesn't work because i_cons is set to 0 - i_cons = 0 - DO isp = 1, atomic_specs_obj%ntyp - IF ( band_structure_obj%noncolin ) THEN - angle1(isp) = theta - angle2(isp) = phi - IF ( atomic_specs_obj%species(isp)%starting_magnetization_ispresent .AND. & - i_cons == 1 ) THEN - mcons(1,isp) = starting_magnetization(isp) * sin(angle1(isp)) * cos(angle2(isp)) - mcons(2,isp) = starting_magnetization(isp) * sin(angle1(isp)) * sin(angle2(isp)) - mcons(3,isp) = starting_magnetization(isp) * cos(angle1(isp)) - ELSE IF ( i_cons == 2) THEN - mcons(3,isp) = cos(angle1(isp)) - END IF - ELSE IF ( atomic_specs_obj%species(isp)%starting_magnetization_ispresent .AND. & - i_cons == 1 ) THEN - mcons(1,isp) = starting_magnetization(isp) - END IF - END DO ! END SUBROUTINE readschema_magnetization !----------------------------------------------------------------------- diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index cea2c87192..025f0fb792 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -137,7 +137,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE paw_variables, ONLY : okpaw ! USE pw_restart_new, ONLY : pw_read_schema, & - readschema_spin, readschema_magnetization, & + readschema_magnetization, & readschema_occupations, readschema_brillouin_zone, & readschema_band_structure USE qes_types_module,ONLY : output_type, parallel_info_type, & @@ -266,9 +266,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) !! nkstot, isk, natomwfc, nbnd_up, nbnd_dw, nelec, wk, wg, & !! ef, ef_up, ef_dw, et ) !! - CALL readschema_spin( output_obj%magnetization ) CALL readschema_magnetization ( output_obj%band_structure, & - output_obj%atomic_species, output_obj%magnetization ) + output_obj%magnetization ) CALL readschema_occupations( output_obj%band_structure ) CALL readschema_brillouin_zone( output_obj%band_structure ) CALL readschema_band_structure( output_obj%band_structure ) From bbe61c6a120467a2da1033c16eb5fa2f956551b3 Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Mon, 24 Jun 2019 09:15:00 +0200 Subject: [PATCH 22/95] A fix for libxc EXCHANGE+CORRELATION functionals --- Modules/funct.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Modules/funct.f90 b/Modules/funct.f90 index d7e142b488..3febec3895 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -642,7 +642,7 @@ SUBROUTINE set_dft_from_name( dft_ ) CALL xc_f90_func_end( xc_func ) ENDIF ! - IF (icorr/=notset .AND. fkind==XC_EXCHANGE_CORRELATION) & + IF (icorr/=0 .AND. fkind==XC_EXCHANGE_CORRELATION) & CALL errore( 'set_dft_from_name', 'An EXCHANGE+CORRELATION functional has & &been found together with a correlation one', 2 ) ! @@ -653,7 +653,7 @@ SUBROUTINE set_dft_from_name( dft_ ) CALL xc_f90_func_end( xc_func ) ENDIF ! - IF (icorr/=notset .AND. fkind==XC_EXCHANGE_CORRELATION) & + IF (icorr/=0 .AND. fkind==XC_EXCHANGE_CORRELATION) & CALL errore( 'set_dft_from_name', 'An EXCHANGE+CORRELATION functional has & &been found together with a correlation one', 3 ) ! From 4a8bd335b5edb5e2338e5bfcdb4197abb41c9ca5 Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Mon, 24 Jun 2019 13:42:51 +0200 Subject: [PATCH 23/95] metaGGA vectorized and libxc incorporated --- CPV/src/make.depend | 1 + CPV/src/metaxc.f90 | 218 ++-- Modules/Makefile | 1 + Modules/funct.f90 | 377 ++----- Modules/make.depend | 3 + Modules/metagga.f90 | 1959 ++++++++++++++++------------------- Modules/xc_mgga_drivers.f90 | 420 ++++++++ PP/src/benchmark_libxc.f90 | 388 +++++-- PP/src/make.depend | 1 + PW/src/make.depend | 2 + PW/src/stres_gradcorr.f90 | 99 +- PW/src/v_of_rho.f90 | 222 ++-- 12 files changed, 1904 insertions(+), 1787 deletions(-) create mode 100644 Modules/xc_mgga_drivers.f90 diff --git a/CPV/src/make.depend b/CPV/src/make.depend index 8480f08db1..8421c5c5e2 100644 --- a/CPV/src/make.depend +++ b/CPV/src/make.depend @@ -717,6 +717,7 @@ manycp.o : ../../Modules/read_input.o manycp.o : input.o metaxc.o : ../../Modules/funct.o metaxc.o : ../../Modules/kind.o +metaxc.o : ../../Modules/xc_mgga_drivers.o modules.o : ../../Modules/kind.o modules.o : ../../Modules/uspp.o move_electrons.o : ../../Modules/cell_base.o diff --git a/CPV/src/metaxc.f90 b/CPV/src/metaxc.f90 index 69514bb3eb..9c96df000f 100644 --- a/CPV/src/metaxc.f90 +++ b/CPV/src/metaxc.f90 @@ -10,190 +10,96 @@ SUBROUTINE tpssmeta(nnr, nspin,grho,rho,kedtau,etxc) ! =================== !-------------------------------------------------------------------- - use kinds, only: dp - use funct, only: tau_xc, tau_xc_spin, tau_xc_array, tau_xc_array_spin, get_meta + use kinds, only: dp + use funct, only: get_meta + use xc_mgga, only: xc_metagcx, change_threshold_mgga !, & + !tau_xc_array, tau_xc_array_spin + ! IMPLICIT NONE ! ! input - integer nspin , nnr - real(dp) grho(3,nnr,nspin), rho(nnr,nspin),kedtau(nnr,nspin) + integer :: nspin, nnr + real(dp) :: grho(3,nnr,nspin), rho(nnr,nspin), kedtau(nnr,nspin) ! output: excrho: exc * rho ; E_xc = \int excrho(r) d_r ! output: rhor: contains the exchange-correlation potential - real(dp) etxc + real(dp) :: etxc REAL(dp) :: zeta, rh, grh2 INTEGER :: k, ipol, is REAL(dp), PARAMETER :: epsr = 1.0d-6, epsg = 1.0d-10 INTEGER :: imeta + ! etxc = 0.d0 ! calculate the gradient of rho+rho_core in real space imeta = get_meta() - if (imeta.eq.5.or.imeta.eq.6.or.imeta.eq.7) then - call exch_corr_meta_array_mode() !HK/MCA: currently only implmented for SCAN - else - call exch_corr_meta_scalar_mode() !HK/MCA: compatibility for the original implementation - end if + ! + call exch_corr_meta() !HK/MCA + ! RETURN -contains - - subroutine exch_corr_meta_array_mode() + ! + ! + contains + ! + ! + subroutine exch_corr_meta() + ! implicit none - real(dp) :: grho_(3,nnr,nspin) !MCA/HK : store grho only in nspin=2 - REAL(dp) :: arho(nnr), segno(nnr), grho2 (nnr), & - & sx(nnr), sc(nnr), & - & v1x(nnr,nspin), v2x(nnr,nspin*2-1), v3x(nnr,nspin), & !MCA/HK - & v1c(nnr,nspin), v2c(nnr,nspin*2-1), v3c(nnr,nspin) !MCA/HK - IF (nspin == 1) THEN - ! - !$omp parallel do - do k = 1, nnr - ! - grho2(k) = grho(1,k,1)**2 + grho(2,k,1)**2 + grho(3,k,1)**2 - arho(k) = ABS (rho (k,1) ) - segno(k) = SIGN (1.d0, rho (k,1) ) - ! - end do !k - !$omp end parallel do + ! + INTEGER :: np + REAL(DP), ALLOCATABLE :: sx(:), v1x(:,:), v2x(:,:), v3x(:,:), & + sc(:), v1c(:,:), v2c(:,:,:), v3c(:,:) + ! + np=1 + if (nspin==2) np=3 + ! + allocate( sx(nnr), v1x(nnr,nspin), v2x(nnr,nspin), v3x(nnr,nspin) ) + allocate( sc(nnr), v1c(nnr,nspin), v2c(np,nnr,nspin), v3c(nnr,nspin) ) + ! + if (nspin==1) then ! - CALL tau_xc_array (nnr,arho,grho2,kedtau,sx,sc,v1x,v2x,v3x,v1c,v2c,v3c) + call change_threshold_mgga( epsr, epsg, epsr ) ! - ! store potentials + call xc_metagcx( nnr, 1, np, rho, grho, kedtau, sx, sc, & + v1x, v2x, v3x, v1c, v2c, v3c ) ! - rho (:, 1) = ( v1x(:,1) + v1c(:,1) ) - kedtau(:,1) = ( v3x(:,1) + v3c(:,1) ) *0.5_dp + rho(:,1) = v1x(:,1) + v1c(:,1) + kedtau(:,1) = (v3x(:,1) + v3c(:,1)) * 0.5d0 + ! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| + do ipol = 1, 3 + grho(ipol,:,1) = (v2x(:,1) + v2c(1,:,1))*grho(ipol,:,1) + enddo + etxc = SUM( (sx(:) + sc(:)) * SIGN(1.d0,rho(:,1)) ) ! - ! v2 contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| + else ! - DO ipol = 1, 3 - grho(ipol,:,1) = ( v2x(:,1) + v2c(:,1) )*grho (ipol,:,1) - ENDDO + call change_threshold_mgga( epsr ) ! - ELSE + call xc_metagcx( nnr, 2, np, rho, grho, kedtau, sx, sc, & + v1x, v2x, v3x, v1c, v2c, v3c ) ! - !MCA/HK: only SCAN is available - CALL tau_xc_array_spin (nnr, rho, grho, kedtau, sx, sc, v1x, v2x, & - & v3x, v1c, v2c, v3c) + rho(:,1) = v1x(:,1) + v1c(:,1) + rho(:,2) = v1x(:,2) + v1c(:,2) ! - ! MCA/HK : store grho to compute v2x cross terms + ! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| ! - grho_ = grho + do ipol = 1, 3 + grho(ipol,:,1) = (v2x(:,1)*grho(ipol,:,1) + v2c(ipol,:,1)) + grho(ipol,:,2) = (v2x(:,2)*grho(ipol,:,2) + v2c(ipol,:,2)) + enddo ! - DO is = 1,nspin - ! - rho(:, is) = v1x(:,is) + v1c(:,is) - ! - DO ipol = 1, 3 !MCA/HK: second line is the cross term - grho(ipol,:,is) = ( v2x(:,2*is-1) + v2c(:,2*is-1) ) * grho(ipol,:,is) & - & + 0.5_dp * ( v2x(:,2) + v2c(:,2) ) * grho_(ipol,:,MOD(is,2)+1) - ENDDO - ! - kedtau(:,is)= ( v3x(:,is) + v3c(:,is) ) *0.5d0 - ! - segno = 1.0 !MCA: not the most efficient way - ! - ENDDO + kedtau(:,1) = (v3x(:,1) + v3c(:,1)) * 0.5d0 + kedtau(:,2) = (v3x(:,2) + v3c(:,2)) * 0.5d0 + etxc = etxc + SUM( sx(:) + sc(:) ) ! - ENDIF + endif + ! + deallocate( sx, v1x, v2x, v3x ) + deallocate( sc, v1c, v2c, v3c ) ! - ! compute exc energy contribution from the current process ! - etxc = 0.0_dp - !$omp parallel do reduction(+:etxc) - do k = 1, nnr - etxc = etxc + (sx(k) + sc(k)) * segno(k) - end do !k - !$omp end parallel do - return - end subroutine exch_corr_meta_array_mode - - subroutine exch_corr_meta_scalar_mode() - implicit none - REAL(dp) :: grho2 (2), sx, sc, v1x, v2x, v3x,v1c, v2c, v3c, & - v1xup, v1xdw, v2xup, v2xdw, v1cup, v1cdw ,v2cup(3),v2cdw(3), & - v3xup, v3xdw,grhoup(3),grhodw(3),v3cup, v3cdw, segno, arho, atau - DO k = 1, nnr - DO is = 1, nspin - grho2 (is) = grho(1,k, is)**2 + grho(2,k,is)**2 + grho(3,k,is)**2 - ENDDO - IF (nspin == 1) THEN - ! - ! This is the spin-unpolarised case - ! - arho = ABS (rho (k, 1) ) - segno = SIGN (1.d0, rho (k, 1) ) - atau = kedtau(k,1) - IF (arho.GT.epsr.AND.grho2 (1) .GT.epsg.AND.ABS(atau).GT.epsr) THEN - CALL tau_xc (arho, grho2(1), atau, sx, sc, & - v1x, v2x, v3x, v1c, v2c, v3c) - rho (k, 1) = (v1x + v1c ) - kedtau(k,1)= (v3x + v3c) *0.5d0 - ! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| - DO ipol = 1, 3 - grho(ipol,k,1) = (v2x + v2c)*grho (ipol,k,1) - ENDDO - etxc = etxc + (sx + sc) * segno - ELSE - DO ipol = 1, 3 - grho (ipol,k,1) = 0.d0 - ENDDO - kedtau(k,1)=0.d0 - ENDIF - ELSE - ! - ! spin-polarised case - ! - !CALL tpsscx_spin(rho (k, 1), rho (k, 2), grho2 (1), grho2 (2), & - ! kedtau(k,1),kedtau(k,2),sx, & - ! v1xup,v1xdw,v2xup,v2xdw,v3xup,v3xdw) - rh = rho (k, 1) + rho (k, 2) - IF (rh.GT.epsr) THEN - !zeta = (rho (k, 1) - rho (k, 2) ) / rh - DO ipol=1,3 - grhoup(ipol)=grho(ipol,k,1) - grhodw(ipol)=grho(ipol,k,2) - END DO - ! atau=kedtau(k,1)+kedtau(k,2) - call tau_xc_spin (rho(k,1), rho(k,2), grhoup, grhodw, & - kedtau(k,1), kedtau(k,2), sx, sc, v1xup, v1xdw, v2xup, v2xdw, & - v3xup, v3xdw, v1cup, v1cdw, v2cup, v2cdw,& - v3cup, v3cdw) - !CALL tpsscc_spin(rh,zeta,grhoup,grhodw, & - ! atau,sc,v1cup,v1cdw,v2cup,v2cdw,v3c) - ELSE - sx = 0.d0 - sc = 0.d0 - v1xup = 0.d0 - v1xdw = 0.d0 - v2xup=0.d0 - v2xdw=0.d0 - v3xup=0.d0 - v3xdw=0.d0 - v1cup = 0.d0 - v1cdw = 0.d0 - v2cup=0.d0 - v2cdw=0.d0 - v3cup=0.d0 - v3cdw=0.d0 - ! - ENDIF - ! - ! first term of the gradient correction : D(rho*Exc)/D(rho) - ! - rho(k, 1) = (v1xup + v1cup) - rho(k, 2) = (v1xdw + v1cdw) - ! - ! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| - ! - DO ipol = 1, 3 - grho(ipol,k,1) = (v2xup*grho(ipol,k,1) + v2cup(ipol)) - grho(ipol,k,2) = (v2xdw*grho(ipol,k,2) + v2cdw(ipol)) - ENDDO - kedtau(k,1)= (v3xup + v3cup) *0.5d0 - kedtau(k,2)= (v3xdw + v3cdw) *0.5d0 - etxc = etxc + (sx + sc) - ENDIF - ENDDO return - end subroutine exch_corr_meta_scalar_mode + ! + end subroutine exch_corr_meta + ! END SUBROUTINE tpssmeta !----------------------------------------------------------------------- diff --git a/Modules/Makefile b/Modules/Makefile index 2683d74e76..5f105d7907 100644 --- a/Modules/Makefile +++ b/Modules/Makefile @@ -111,6 +111,7 @@ xc_vdW_DF.o \ xc_rVV10.o \ xc_lda_lsda_drivers.o \ xc_gga_drivers.o \ +xc_mgga_drivers.o \ io_base.o \ qes_types_module.o \ qes_libs_module.o \ diff --git a/Modules/funct.f90 b/Modules/funct.f90 index 3febec3895..044afb5e5d 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -50,7 +50,7 @@ MODULE funct PUBLIC :: enforce_input_dft, write_dft_name PUBLIC :: get_dft_name, get_dft_short, get_dft_long,& get_nonlocc_name - PUBLIC :: get_iexch, get_icorr, get_igcx, get_igcc, get_meta, get_inlc + PUBLIC :: get_iexch, get_icorr, get_igcx, get_igcc, get_meta, get_metac, get_inlc PUBLIC :: dft_is_gradient, dft_is_meta, dft_is_hybrid, dft_is_nonlocc, igcc_is_lyp PUBLIC :: set_auxiliary_flags ! @@ -67,8 +67,6 @@ MODULE funct ! ! driver subroutines computing XC PUBLIC :: init_xc, is_libxc - PUBLIC :: tau_xc , tau_xc_spin - PUBLIC :: tau_xc_array, tau_xc_array_spin PUBLIC :: nlc ! ! PRIVATE variables defining the DFT functional @@ -327,10 +325,11 @@ MODULE funct INTEGER :: igcx = notset INTEGER :: igcc = notset INTEGER :: imeta = notset + INTEGER :: imetac= notset INTEGER :: inlc = notset ! ! is_libxc(i)==.TRUE. if the the i-th term of xc is from libxc - LOGICAL :: is_libxc(6) + LOGICAL :: is_libxc(7) ! REAL(DP):: exx_fraction = 0.0_DP REAL(DP):: screening_parameter = 0.0_DP @@ -390,7 +389,8 @@ SUBROUTINE set_dft_from_name( dft_ ) CHARACTER(len=50):: dftout LOGICAL :: dft_defined = .FALSE. CHARACTER(LEN=1), EXTERNAL :: capital - INTEGER :: save_iexch, save_icorr, save_igcx, save_igcc, save_meta, save_inlc + INTEGER :: save_iexch, save_icorr, save_igcx, save_igcc, save_meta, & + save_metac, save_inlc #if defined(__LIBXC) INTEGER :: fkind TYPE(xc_f90_pointer_t) :: xc_func, xc_info @@ -407,6 +407,7 @@ SUBROUTINE set_dft_from_name( dft_ ) save_igcx = igcx save_igcc = igcc save_meta = imeta + save_metac = imetac save_inlc = inlc ! ! convert to uppercase @@ -621,6 +622,26 @@ SUBROUTINE set_dft_from_name( dft_ ) END SELECT ! ! + ! ... A temporary fix in order to keep the q-e input notation for SCAN-functionls + ! valid. + IF (imeta==5 .OR. imeta==6) THEN +#if defined(__LIBXC) + imeta = 263 + imetac = 267 + is_libxc(5:6) = .TRUE. +#else + CALL errore( 'set_dft_from_name', 'libxc needed for this functional', 2 ) +#endif + ELSEIF (imeta==3) THEN +#if defined(__LIBXC) + imeta = 208 + imetac = 231 + is_libxc(5:6) = .TRUE. +#else + CALL errore( 'set_dft_from_name', 'libxc needed for this functional', 2 ) +#endif + ENDIF + ! !---------------------------------------------------------------- ! If the DFT was not yet defined, check every part of the string !---------------------------------------------------------------- @@ -632,7 +653,12 @@ SUBROUTINE set_dft_from_name( dft_ ) igcx = matching( 3, dftout, ngcx, gradx, is_libxc(3) ) igcc = matching( 4, dftout, ngcc, gradc, is_libxc(4) ) imeta = matching( 5, dftout, nmeta, meta, is_libxc(5) ) - inlc = matching( 6, dftout, ncnl, nonlocc, is_libxc(6) ) + IF ( is_libxc(5) ) THEN + imetac = matching( 6, dftout, nmeta, meta, is_libxc(6) ) + ELSE + imetac = 0 + ENDIF + inlc = matching( 7, dftout, ncnl, nonlocc, is_libxc(7) ) ! #if defined(__LIBXC) fkind = -100 @@ -660,6 +686,10 @@ SUBROUTINE set_dft_from_name( dft_ ) IF (ANY(is_libxc(1:2)) .AND. ANY(is_libxc(3:4))) & CALL errore( 'set_dft_from_name', 'An LDA functional has been found, but & &libxc GGA functionals already include the LDA part)', 4 ) + ! + IF (imeta/=0 .AND. (.NOT. is_libxc(5)) .AND. imetac/=0) & + CALL errore( 'set_dft_from_name', 'Two conflicting metaGGA functionals & + &have been found', 5 ) #endif ! ENDIF @@ -718,6 +748,10 @@ SUBROUTINE set_dft_from_name( dft_ ) WRITE (stdout,*) inlc, save_meta CALL errore( 'set_dft_from_name', ' conflicting values for imeta', 1 ) ENDIF + IF (save_metac /= notset .AND. save_metac /= imetac) THEN + WRITE (stdout,*) imetac, save_metac + CALL errore( 'set_dft_from_name', ' conflicting values for imetac', 1 ) + ENDIF IF (save_inlc /= notset .AND. save_inlc /= inlc) THEN WRITE (stdout,*) inlc, save_inlc CALL errore( 'set_dft_from_name', ' conflicting values for inlc', 1 ) @@ -835,9 +869,16 @@ FUNCTION slot_match_libxc( fslot, family, fkind ) IF (family==XC_FAMILY_HYB_GGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN CASE( 4 ) IF (family==XC_FAMILY_GGA .AND. fkind==XC_CORRELATION) RETURN + CASE( 5 ) + IF (family==XC_FAMILY_MGGA .AND. fkind==XC_EXCHANGE) RETURN + IF (family==XC_FAMILY_MGGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN + IF (family==XC_FAMILY_HYB_MGGA .AND. fkind==XC_EXCHANGE) RETURN + IF (family==XC_FAMILY_HYB_MGGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN + CASE( 6 ) + IF (family==XC_FAMILY_MGGA .AND. fkind==XC_CORRELATION) RETURN END SELECT - ! #endif + ! slot_match_libxc=.FALSE. ! RETURN @@ -903,6 +944,7 @@ LOGICAL FUNCTION set_dft_values( i1, i2, i3, i4, i5, i6 ) igcc = i4 inlc = i5 imeta = i6 + imetac= 0 ! set_dft_values = .TRUE. ! @@ -1077,6 +1119,12 @@ FUNCTION get_meta() get_meta = imeta RETURN END FUNCTION get_meta + ! + FUNCTION get_metac() + INTEGER get_metac + get_metac = imetac + RETURN + END FUNCTION get_metac !----------------------------------------------------------------------- FUNCTION get_inlc() INTEGER get_inlc @@ -1218,23 +1266,23 @@ FUNCTION get_dft_short() ! IF ( iexch==1 .AND. igcx==0 .AND. igcc==0) THEN shortname = TRIM(corr(icorr)) - ELSEIF (iexch==4 .AND. icorr== 0 .AND. igcx==0 .AND. igcc== 0) THEN + ELSEIF (iexch==4 .AND. icorr==0 .AND. igcx==0 .AND. igcc== 0) THEN shortname = 'OEP' ELSEIF (iexch==1 .AND. icorr==11 .AND. igcx==0 .AND. igcc== 0) THEN shortname = 'VWN-RPA' - ELSEIF (iexch==1 .AND. icorr== 3 .AND. igcx==1 .AND. igcc== 3) THEN + ELSEIF (iexch==1 .AND. icorr==3 .AND. igcx==1 .AND. igcc== 3) THEN shortname = 'BLYP' - ELSEIF (iexch==1 .AND. icorr== 1 .AND. igcx==1 .AND. igcc== 0) THEN + ELSEIF (iexch==1 .AND. icorr==1 .AND. igcx==1 .AND. igcc== 0) THEN shortname = 'B88' - ELSEIF (iexch==1 .AND. icorr== 1 .AND. igcx==1 .AND. igcc== 1) THEN + ELSEIF (iexch==1 .AND. icorr==1 .AND. igcx==1 .AND. igcc== 1) THEN shortname = 'BP' - ELSEIF (iexch==1 .AND. icorr== 4 .AND. igcx==2 .AND. igcc== 2) THEN + ELSEIF (iexch==1 .AND. icorr==4 .AND. igcx==2 .AND. igcc== 2) THEN shortname = 'PW91' - ELSEIF (iexch==1 .AND. icorr== 4 .AND. igcx==3 .AND. igcc== 4) THEN + ELSEIF (iexch==1 .AND. icorr==4 .AND. igcx==3 .AND. igcc== 4) THEN shortname = 'PBE' - ELSEIF (iexch==6 .AND. icorr== 4 .AND. igcx==8 .AND. igcc== 4) THEN + ELSEIF (iexch==6 .AND. icorr==4 .AND. igcx==8 .AND. igcc== 4) THEN shortname = 'PBE0' - ELSEIF (iexch==6 .AND. icorr== 4 .AND. igcx==41.AND. igcc== 4) THEN + ELSEIF (iexch==6 .AND. icorr==4 .AND. igcx==41.AND. igcc== 4) THEN shortname = 'B86BPBEX' ELSEIF (iexch==6 .AND. icorr==4 .AND. igcx==42.AND. igcc== 3) THEN shortname = 'BHANDHLYP' @@ -1371,9 +1419,11 @@ SUBROUTINE init_xc( family ) USE xc_lda_lsda, ONLY: libxc_switches_lda, iexch_l, icorr_l, & exx_started_l, is_there_finite_size_corr, & exx_fraction_l, finite_size_cell_volume_l - USE xc_gga, ONLY: libxc_switches_gga, igcx_l, igcc_l, & - exx_started_g, exx_fraction_g, & + USE xc_gga, ONLY: libxc_switches_gga, igcx_l, igcc_l, & + exx_started_g, exx_fraction_g, & screening_parameter_l, gau_parameter_l + USE xc_mgga, ONLY: libxc_switches_mgga, imeta_l, imetac_l, & + exx_started_mg, exx_fraction_mg ! IMPLICIT NONE ! @@ -1387,8 +1437,8 @@ SUBROUTINE init_xc( family ) iexch_l = get_iexch() icorr_l = get_icorr() ! - IF (iexch_l==-1 .OR. icorr_l==-1) CALL errore( 'init_xc', 'LDA functional & - & indexes not well defined', 1 ) + IF (iexch_l==notset .OR. icorr_l==notset) CALL errore( 'init_xc', 'LDA functional & + & indexes not defined', 1 ) ! ! hybrid exchange vars exx_started_l = exx_started !is_active() @@ -1408,8 +1458,8 @@ SUBROUTINE init_xc( family ) igcx_l = get_igcx() igcc_l = get_igcc() ! - IF (igcx_l==-1 .OR. igcc_l==-1) CALL errore( 'init_xc', 'GGA functional & - & indexes not well defined', 2 ) + IF (igcx_l==notset .OR. igcc_l==notset) CALL errore( 'init_xc', 'GGA functional & + & indexes not defined', 2 ) ! ! hybrid exchange vars exx_started_g = exx_started !is_active() @@ -1420,8 +1470,26 @@ SUBROUTINE init_xc( family ) gau_parameter_l = get_gau_parameter() ENDIF ! - IF (family.NE.'LDA' .AND. family.NE.'GGA' .AND. family.NE.'ALL') & - CALL errore( 'init_xc', 'family not found', 3 ) + IF (family.EQ.'MGGA' .OR. family.EQ.'ALL') THEN + ! =1 if libxc active, =0 otherwise + IF (is_libxc(5)) libxc_switches_mgga(1) = 1 + IF (is_libxc(6)) libxc_switches_mgga(2) = 1 + ! exchange-correlation indexes + imeta_l = get_meta() + imetac_l = get_metac() + ! + IF (imeta_l==notset .OR. imetac_l==notset) CALL errore( 'init_xc', 'MGGA functional & + & indexes not defined', 3 ) + ! + ! hybrid exchange vars + exx_started_mg = exx_started !is_active() + exx_fraction_mg = 0._DP + IF ( exx_started_mg ) exx_fraction_mg = get_exx_fraction() + ! + ENDIF + ! + IF ( family.NE.'LDA' .AND. family.NE.'GGA' .AND. family.NE.'MGGA' .AND. family.NE.'ALL') & + CALL errore( 'init_xc', 'family not found', 4 ) ! RETURN ! @@ -1479,269 +1547,6 @@ SUBROUTINE nlc (rho_valence, rho_core, nspin, enl, vnl, v) ! RETURN END SUBROUTINE nlc - -! -!----------------------------------------------------------------------- -!------- META CORRECTIONS DRIVERS ---------------------------------- -!----------------------------------------------------------------------- -! -!----------------------------------------------------------------------- -SUBROUTINE tau_xc (rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - !----------------------------------------------------------------------- - ! gradient corrections for exchange and correlation - Hartree a.u. - ! See comments at the beginning of module for implemented cases - ! - ! input: rho, grho=|\nabla rho|^2 - ! - ! definition: E_x = \int e_x(rho,grho) dr - ! - ! output: sx = e_x(rho,grho) = grad corr - ! v1x= D(E_x)/D(rho) - ! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| - ! v3x= D(E_x)/D(tau) - ! - ! sc, v1c, v2c as above for correlation - ! - IMPLICIT NONE - - REAL(DP) :: rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c - - !_________________________________________________________________________ - - if (imeta == 1) then - CALL tpsscxc (rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - elseif (imeta == 2) then - CALL m06lxc (rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - elseif (imeta == 3) then - CALL tb09cxc (rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - elseif (imeta == 4) then - ! do nothing - elseif (imeta == 5) then - CALL SCANcxc (rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - else - CALL errore('tau_xc','wrong igcx and/or igcc',1) - end if - - RETURN - -END SUBROUTINE tau_xc - -SUBROUTINE tau_xc_array (nnr, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - ! HK/MCA : the xc_func_init is slow and is called too many times - ! HK/MCA : we modify this subroutine so that the overhead could be minimized - !----------------------------------------------------------------------- - ! gradient corrections for exchange and correlation - Hartree a.u. - ! See comments at the beginning of module for implemented cases - ! - ! input: rho, grho=|\nabla rho|^2 - ! - ! definition: E_x = \int e_x(rho,grho) dr - ! - ! output: sx = e_x(rho,grho) = grad corr - ! v1x= D(E_x)/D(rho) - ! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| - ! v3x= D(E_x)/D(tau) - ! - ! sc, v1c, v2c as above for correlation - ! - IMPLICIT NONE - - INTEGER, intent(in) :: nnr - REAL(DP) :: rho(nnr), grho(nnr), tau(nnr), ex(nnr), ec(nnr) - REAL(DP) :: v1x(nnr), v2x(nnr), v3x(nnr), v1c(nnr), v2c(nnr), v3c(nnr) - !_________________________________________________________________________ - - if (imeta == 5) then - CALL scancxc_array (nnr, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - elseif (imeta == 6 ) then ! HK/MCA: SCAN0 - CALL scancxc_array (nnr, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - if (exx_started) then - ex = (1.0_DP - exx_fraction) * ex - v1x = (1.0_DP - exx_fraction) * v1x - v2x = (1.0_DP - exx_fraction) * v2x - v3x = (1.0_DP - exx_fraction) * v3x - end if - else - CALL errore('v_xc_meta_array','(CP only) array mode only works for SCAN',1) - end if - - RETURN - -END SUBROUTINE tau_xc_array -! -! -!----------------------------------------------------------------------- -SUBROUTINE tau_xc_spin (rhoup, rhodw, grhoup, grhodw, tauup, taudw, ex, ec, & - & v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, v1cup, v1cdw,& - & v2cup, v2cdw, v3cup, v3cdw) - -!----------------------------------------------------------------------- - ! - ! - - IMPLICIT NONE - - real(dp), intent(in) :: rhoup, rhodw, tauup, taudw - real(dp), dimension (3), intent(in) :: grhoup, grhodw - - real(dp), intent(out) :: ex, ec, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, & - & v1cup, v1cdw, v3cup, v3cdw - real(dp), dimension(3), intent(out) :: v2cup, v2cdw - - ! - ! Local variables - ! - INTEGER :: ipol - real(dp) :: rh, zeta, atau, grhoup2, grhodw2 - real(dp), parameter :: epsr=1.0d-08, zero=0._dp - ! - !_____________________________ - - grhoup2 = zero - grhodw2 = zero - - v2cup = zero - v2cdw = zero - - ! FIXME: for SCAN, this will be calculated later - if (imeta /= 4) then - - do ipol=1,3 - grhoup2 = grhoup2 + grhoup(ipol)**2 - grhodw2 = grhodw2 + grhodw(ipol)**2 - end do - - end if - - if (imeta == 1) then - - CALL tpsscx_spin(rhoup, rhodw, grhoup2, grhodw2, tauup, & - & taudw, ex, v1xup,v1xdw,v2xup,v2xdw,v3xup,v3xdw) - - rh = rhoup + rhodw - - zeta = (rhoup - rhodw) / rh - atau = tauup + taudw ! KE-density in Hartree - - CALL tpsscc_spin(rh,zeta,grhoup,grhodw, atau,ec, & - & v1cup,v1cdw,v2cup,v2cdw,v3cup, v3cdw) - - - elseif (imeta == 2) then - - CALL m06lxc_spin (rhoup, rhodw, grhoup2, grhodw2, tauup, taudw, & - & ex, ec, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, & - & v1cup, v1cdw, v2cup(1), v2cdw(1), v3cup, v3cdw) - - elseif (imeta == 5) then - - ! FIXME: not the most efficient use of libxc - - CALL scanxc_spin(rhoup, rhodw, grhoup, grhodw, tauup, taudw, & - & ex, v1xup,v1xdw,v2xup,v2xdw,v3xup,v3xdw, & - & ec, v1cup,v1cdw,v2cup,v2cdw,v3cup,v3cdw ) - - else - - CALL errore('tau_xc_spin','This case not implemented',imeta) - - end if - -END SUBROUTINE tau_xc_spin - -SUBROUTINE tau_xc_array_spin (nnr, rho, grho, tau, ex, ec, v1x, v2x, v3x, & - & v1c, v2c, v3c) -! HK/MCA : the xc_func_init (LIBXC) is slow and is called too many times -! HK/MCA : we modify this SUBROUTINE so that the overhead could be minimized -!----------------------------------------------------------------------- -! gradient corrections for exchange and correlation - Hartree a.u. -! See comments at the beginning of module for implemented cases -! -! input: rho,rho, grho=\nabla rho -! -! definition: E_x = \int e_x(rho,grho) dr -! -! output: sx = e_x(rho,grho) = grad corr -! v1x= D(E_x)/D(rho) -! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| -! v3x= D(E_x)/D(tau) -! -! sc, v1cup, v2cup as above for correlation -! -IMPLICIT NONE - -INTEGER, intent(in) :: nnr -REAL(DP) :: rho(nnr,2), grho(3,nnr,2), tau(nnr,2), ex(nnr), ec(nnr) -REAL(DP) :: v1x(nnr,2), v2x(nnr,3), v3x(nnr,2), v1c(nnr,2), v2c(nnr,3), v3c(nnr,2) - -!Local variables - -INTEGER :: ipol, k, is -REAL(DP) :: grho2(3,nnr) -!MCA: Libxc format -REAL(DP) :: rho_(2,nnr), tau_(2,nnr) -REAL(DP) :: v1x_(2,nnr), v2x_(3,nnr), v3x_(2,nnr), v1c_(2,nnr), v2c_(3,nnr), v3c_(2,nnr) - -!_________________________________________________________________________ - -grho2 = 0.0 - -!MCA/HK: contracted gradient of density, same format as in libxc -do k=1,nnr - -do ipol=1,3 -grho2(1,k) = grho2(1,k) + grho(ipol,k,1)**2 -grho2(2,k) = grho2(2,k) + grho(ipol,k,1) * grho(ipol,k,2) -grho2(3,k) = grho2(3,k) + grho(ipol,k,2)**2 -end do - -!MCA: transforming to libxc format (DIRTY HACK) -do is=1,2 -rho_(is,k) = rho(k,is) -tau_(is,k) = tau(k,is) -enddo - -end do - -if (imeta == 5) then - -!MCA/HK: using the arrays in libxc format -CALL scancxc_array_spin (nnr, rho_, grho2, tau_, ex, ec, & -& v1x_, v2x_, v3x_, & -& v1c_, v2c_, v3c_ ) - -do k=1,nnr - -!MCA: from libxc to QE format (DIRTY HACK) -do is=1,2 -v1x(k,is) = v1x_(is,k) -v2x(k,is) = v2x_(is,k) !MCA/HK: v2x(:,2) contains the cross terms -v3x(k,is) = v3x_(is,k) -v1c(k,is) = v1c_(is,k) -v2c(k,is) = v2c_(is,k) !MCA/HK: same as v2x -v3c(k,is) = v3c_(is,k) -enddo - -v2c(k,3) = v2c_(3,k) -v2x(k,3) = v2x_(3,k) - -end do - -elseif (imeta == 6 ) then ! HK/MCA: SCAN0 -CALL scancxc_array (nnr, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) -if (exx_started) then -ex = (1.0_DP - exx_fraction) * ex -v1x = (1.0_DP - exx_fraction) * v1x -v2x = (1.0_DP - exx_fraction) * v2x -v3x = (1.0_DP - exx_fraction) * v3x -end if -else -CALL errore('v_xc_meta_array','(CP only) array mode only works for SCAN',1) -end if - -RETURN - -END SUBROUTINE tau_xc_array_spin ! ! #if defined(__LIBXC) diff --git a/Modules/make.depend b/Modules/make.depend index 6a39e941fb..0bc51f97da 100644 --- a/Modules/make.depend +++ b/Modules/make.depend @@ -113,6 +113,7 @@ funct.o : kind.o funct.o : libxc.o funct.o : xc_gga_drivers.o funct.o : xc_lda_lsda_drivers.o +funct.o : xc_mgga_drivers.o funct.o : xc_rVV10.o funct.o : xc_vdW_DF.o generate_function.o : ../UtilXlib/mp.o @@ -445,6 +446,8 @@ xc_gga_drivers.o : kind.o xc_gga_drivers.o : libxc.o xc_lda_lsda_drivers.o : kind.o xc_lda_lsda_drivers.o : libxc.o +xc_mgga_drivers.o : kind.o +xc_mgga_drivers.o : libxc.o xc_rVV10.o : ../FFTXlib/fft_interfaces.o xc_rVV10.o : ../UtilXlib/mp.o xc_rVV10.o : cell_base.o diff --git a/Modules/metagga.f90 b/Modules/metagga.f90 index bf5c1480eb..fb067a2309 100644 --- a/Modules/metagga.f90 +++ b/Modules/metagga.f90 @@ -10,162 +10,170 @@ ! ! META-GGA FUNCTIONALS ! -! Available functionals : +! Available functionals : ! - TPSS (Tao, Perdew, Staroverov & Scuseria) -! - TB09 (via libxc) -! - SCAN (via libxc) ! - M06L +! Other options are available through libxc library (must be specified +! in input). ! !========================================================================= -! -!------------------------------------------------------------------------- ! ! TPSS ! !------------------------------------------------------------------------- -!------------------------------------------------------------------------- -subroutine tpsscxc( rho, grho, tau, sx, sc, v1x, v2x, v3x, v1c, v2c, v3c ) +SUBROUTINE tpsscxc( rho, grho, tau, sx, sc, v1x, v2x, v3x, v1c, v2c, v3c ) !----------------------------------------------------------------------- - ! TPSS metaGGA corrections for exchange and correlation - Hartree a.u. + !! TPSS metaGGA corrections for exchange and correlation - Hartree a.u. ! - ! input: rho, grho=|\nabla rho|^2, tau = kinetic energy density - ! definition: E_x = \int E_x(rho,grho) dr - ! output: sx = E_x(rho,grho) - ! v1x= D(E_x)/D(rho) - ! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| - ! sc, v1c, v2c as above for correlation - ! v3x= D(E_x)/D(tau) + !! Definition: E_x = \int E_x(rho,grho) dr ! USE kinds, ONLY : DP -#if defined(__LIBXC) - use xc_f90_types_m - use xc_f90_lib_m -#endif - implicit none - real(DP), intent(in) :: rho, grho, tau - real(dp), intent(out):: sx, sc, v1x, v2x, v3x, v1c, v2c, v3c -#if defined(__LIBXC) - TYPE(xc_f90_pointer_t) :: xc_func - TYPE(xc_f90_pointer_t) :: xc_info - integer :: size = 1 - integer :: func_id = 202 ! - real(dp) :: lapl_rho, vlapl_rho ! not used in TPSS - - lapl_rho = grho - - ! exchange - func_id = 202 - call xc_f90_func_init(xc_func, xc_info, func_id, XC_UNPOLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, size, rho, grho, lapl_rho, tau,& - sx, v1x, v2x, vlapl_rho, v3x) - call xc_f90_func_end(xc_func) - - sx = sx * rho - v2x = v2x*2.0_dp - - ! correlation - func_id = 231 ! Perdew, Tao, Staroverov & Scuseria correlation - call xc_f90_func_init(xc_func, xc_info, func_id, XC_UNPOLARIZED) - call xc_f90_mgga_exc_vxc(xc_func,size , rho, grho, lapl_rho, tau,& - sc, v1c, v2c, vlapl_rho, v3c) - call xc_f90_func_end(xc_func) - - sc = sc * rho - v2c = v2c*2.0_dp - -#else - real(DP), parameter :: small = 1.E-10_DP - - if (rho.le.small) then - sx = 0.0_DP + ! + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: rho + !! the charge density + REAL(DP), INTENT(IN) :: grho + !! grho = |\nabla rho|^2 + REAL(DP), INTENT(IN) :: tau + !! kinetic energy density + REAL(DP), INTENT(OUT) :: sx + !! sx = E_x(rho,grho) + REAL(DP), INTENT(OUT) :: sc + !! sc = E_c(rho,grho) + REAL(DP), INTENT(OUT) :: v1x + !! v1x = D(E_x)/D(rho) + REAL(DP), INTENT(OUT) :: v2x + !! v2x = D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| + REAL(DP), INTENT(OUT) :: v3x + !! v3x = D(E_x)/D(tau) + REAL(DP), INTENT(OUT) :: v1c + !! v1c = D(E_c)/D(rho) + REAL(DP), INTENT(OUT) :: v2c + !! v2c = D(E_c)/D( D rho/D r_alpha ) / |\nabla rho| + REAL(DP), INTENT(OUT) :: v3c + !! v3c = D(E_c)/D(tau) + ! + ! ... local variables + ! + REAL(DP), PARAMETER :: small = 1.E-10_DP + ! + IF (rho <= small) THEN + sx = 0.0_DP v1x = 0.0_DP v2x = 0.0_DP - sc = 0.0_DP + sc = 0.0_DP v1c = 0.0_DP v2c = 0.0_DP v3x = 0.0_DP - v3c=0.0_DP - return - end if + v3c = 0.0_DP + RETURN + ENDIF + ! ! exchange - call metax(rho,grho,tau,sx,v1x,v2x,v3x) + CALL metax( rho, grho, tau, sx, v1x, v2x, v3x ) ! correlation - call metac(rho,grho,tau,sc,v1c,v2c,v3c) + CALL metac( rho, grho, tau, sc, v1c, v2c, v3c ) ! -#endif + RETURN ! - return -end subroutine tpsscxc +END SUBROUTINE tpsscxc +! +! !------------------------------------------------------------------------- -subroutine metax(rho,grho2,tau,ex,v1x,v2x,v3x) - ! --------------------------------------------------------------== - ! == TPSS meta-GGA exchange potential and energy - ! == == - ! ==--------------------------------------------------------------== - - USE kinds, ONLY : DP - - ! NOTA BENE: E_x(rho,grho)=rho\epsilon_x(rho,grho) - ! ex = E_x(rho,grho) NOT \epsilon_x(rho,grho) - ! v1x= D(E_x)/D(rho) - ! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| - ! v3x= D(E_x)/D( tau ) - ! tau is the kinetic energy density - ! the same applies to correlation terms - ! input grho2 is |\nabla rho|^2 - implicit none - ! INPUT - real(DP) :: rho,grho2,tau - ! OUTPUT - real(DP) :: ex,v1x,v2x,v3x - ! LOCAL - real(DP) :: rs, vx_unif, ex_unif +SUBROUTINE metax( rho, grho2, tau, ex, v1x, v2x, v3x ) + !-------------------------------------------------------------------- + !! TPSS meta-GGA exchange potential and energy. + ! + !! NOTE: E_x(rho,grho) = rho\epsilon_x(rho,grho) ; + !! ex = E_x(rho,grho) NOT \epsilon_x(rho,grho) ; + !! v1x= D(E_x)/D(rho) ; + !! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| ; + !! v3x= D(E_x)/D( tau ) ; + !! tau is the kinetic energy density ; + !! the same applies to correlation terms ; + !! input grho2 is |\nabla rho|^2 . + ! + USE kinds, ONLY : DP + ! + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: rho + !! the charge density + REAL(DP), INTENT(IN) :: grho2 + !! grho2 = |\nabla rho|^2 + REAL(DP), INTENT(IN) :: tau + !! kinetic energy density + REAL(DP), INTENT(OUT) :: ex + !! ex = E_x(rho,grho) + REAL(DP), INTENT(OUT) :: v1x + !! v1x = D(E_x)/D(rho) + REAL(DP), INTENT(OUT) :: v2x + !! v2x = D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| + REAL(DP), INTENT(OUT) :: v3x + !! v3x = D(E_x)/D(tau) + ! + ! ... local variables + ! + REAL(DP) :: rs, vx_unif, ex_unif ! ex_unif: lda \epsilon_x(rho) ! ec_unif: lda \epsilon_c(rho) - real(DP) :: small, pi34, third - parameter (small=1.E-10_DP) - parameter (pi34 = 0.6203504908994_DP, third = 1.0_DP / 3.0_DP) + REAL(DP), PARAMETER :: small=1.E-10_DP + REAL(DP), PARAMETER :: pi34=0.6203504908994_DP, third=1.0_DP/3.0_DP ! fx=Fx(p,z) ! fxp=d Fx / d p ! fxz=d Fx / d z - real(DP) fx,f1x,f2x,f3x - - ! ==--------------------------------------------------------------== - if(abs(tau).lt.small) then - ex=0.0_DP - v1x=0.0_DP - v2x=0.0_DP - v3x=0.0_DP - return - endif + REAL(DP) :: fx, f1x, f2x, f3x + ! + IF (ABS(tau) < small) THEN + ex = 0.0_DP + v1x = 0.0_DP + v2x = 0.0_DP + v3x = 0.0_DP + RETURN + ENDIF + ! rs = pi34/rho**third - call slater( rs, ex_unif, vx_unif ) - call metaFX(rho,grho2,tau,fx,f1x,f2x,f3x) - ex =rho*ex_unif - v1x=vx_unif*fx + ex*f1x - v2x=ex*f2x - v3x=ex*f3x - ex =ex*fx - - ! ==--------------------------------------------------------------== - return -end subroutine metax + CALL slater( rs, ex_unif, vx_unif ) + CALL metaFX( rho, grho2, tau, fx, f1x, f2x, f3x ) + ! + ex = rho*ex_unif + v1x = vx_unif*fx + ex*f1x + v2x = ex*f2x + v3x = ex*f3x + ex = ex*fx + ! + RETURN + ! +END SUBROUTINE metax ! ! !------------------------------------------------------------------ SUBROUTINE metac( rho, grho2, tau, ec, v1c, v2c, v3c ) - !------------------------------------------------------------------ + !-------------------------------------------------------------- !! TPSS meta-GGA correlation energy and potentials. ! USE kinds, ONLY : DP - ! + ! IMPLICIT NONE ! - ! INPUT - REAL(DP) :: rho, grho2, tau - ! OUTPUT - REAL(DP) :: ec, v1c, v2c, v3c - ! LOCAL + REAL(DP), INTENT(IN) :: rho + !! the charge density + REAL(DP), INTENT(IN) :: grho2 + !! grho2 = |\nabla rho|^2 + REAL(DP), INTENT(IN) :: tau + !! kinetic energy density + REAL(DP), INTENT(OUT) :: ec + !! ec = E_c(rho,grho) + REAL(DP), INTENT(OUT) :: v1c + !! v1c = D(E_c)/D(rho) + REAL(DP), INTENT(OUT) :: v2c + !! v2c = D(E_c)/D( D rho/D r_alpha ) / |\nabla rho| + REAL(DP), INTENT(OUT) :: v3c + !! v3c = D(E_c)/D(tau) + ! + ! ... local variables + ! REAL(DP) :: z, z2, tauw, ec_rev REAL(DP) :: d1rev, d2rev, d3rev ! d1ec= D ec_rev / D rho @@ -195,7 +203,7 @@ SUBROUTINE metac( rho, grho2, tau, ec, v1c, v2c, v3c ) RETURN ENDIF ! - rhoup = 0.5_DP*rho + rhoup = 0.5_DP*rho grhoup = 0.5_DP*SQRT(grho2) ! IF (rhoup > small) THEN @@ -235,9 +243,9 @@ SUBROUTINE metac( rho, grho2, tau, ec, v1c, v2c, v3c ) v2c_pbe = v2c_pbe/rho ! IF (ec_sum < ec_pbe) THEN - ec_sum = ec_pbe + ec_sum = ec_pbe v1c_sum(1) = v1c_pbe - v2c_sum = v2c_pbe + v2c_sum = v2c_pbe ENDIF ! tauw = 0.1250_DP * grho2/rho @@ -245,13 +253,14 @@ SUBROUTINE metac( rho, grho2, tau, ec, v1c, v2c, v3c ) z2 = z*z ! ec_rev = ec_pbe*(1+cab*z2)-cabone*z2*ec_sum + ! d1rev = v1c_pbe + (cab*v1c_pbe-cabone*v1c_sum(1))*z2 & - -(ec_pbe*cab - ec_sum*cabone)*2.0_DP*z2/rho - d2rev = v2c_pbe + (cab*v2c_pbe-cabone*v2c_sum)*z2 & - +(ec_pbe*cab - ec_sum*cabone)*4.0_DP*z2/grho2 + - (ec_pbe*cab - ec_sum*cabone)*2.0_DP*z2/rho + d2rev = v2c_pbe + (cab*v2c_pbe-cabone*v2c_sum)*z2 & + + (ec_pbe*cab - ec_sum*cabone)*4.0_DP*z2/grho2 d3rev = -(ec_pbe*cab - ec_sum*cabone)*2.0_DP*z2/tau ! - cf1 = 1.0_DP+dd*ec_rev*z2*z + cf1 = 1.0_DP + dd*ec_rev*z2*z cf2 = rho*(1.0_DP+2.0_DP*z2*z*dd*ec_rev) cf3 = ec_rev*ec_rev*3.0_DP*dd*z2*z v1c = ec_rev*cf1 + cf2*d1rev-cf3 @@ -269,225 +278,277 @@ END SUBROUTINE metac ! ! !------------------------------------------------------------------------- -subroutine metaFX(rho,grho2,tau,fx,f1x,f2x,f3x) +SUBROUTINE metaFX( rho, grho2, tau, fx, f1x, f2x, f3x ) !------------------------------------------------------------------------- - USE kinds, ONLY : DP - implicit none - ! INPUT - ! charge density, square of gradient of rho, and kinetic energy density - real(DP) rho, grho2, tau - ! OUTPUT - ! fx = Fx(p,z) - ! f1x=D (Fx) / D rho - ! f2x=D (Fx) / D ( D rho/D r_alpha) /|nabla rho| - ! f3x=D (Fx) / D tau - real(DP) fx, f1x, f2x, f3x - ! LOCAL - real(DP) x, p, z, qb, al, localdp, dz - real(DP) dfdx, dxdp, dxdz, dqbdp, daldp, dqbdz, daldz - real(DP) fxp, fxz ! fxp =D fx /D p - real(DP) tauw, tau_unif + ! + USE kinds, ONLY : DP + ! + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: rho + !! charge density + REAL(DP), INTENT(IN) :: grho2 + !! square of gradient of rho + REAL(DP), INTENT(IN) :: tau + !! kinetic energy density + REAL(DP), INTENT(OUT) :: fx + !! fx = Fx(p,z) + REAL(DP), INTENT(OUT) :: f1x + !! f1x=D (Fx) / D rho + REAL(DP), INTENT(OUT) :: f2x + !! f2x=D (Fx) / D ( D rho/D r_alpha) /|nabla rho| + REAL(DP), INTENT(OUT) :: f3x + !! f3x=D (Fx) / D tau + ! + ! ... local variables + ! + REAL(DP) x, p, z, qb, al, localdp, dz + REAL(DP) dfdx, dxdp, dxdz, dqbdp, daldp, dqbdz, daldz + REAL(DP) fxp, fxz ! fxp =D fx /D p + REAL(DP) tauw, tau_unif ! work variables - real(DP) xf1,xf2 - real(DP) xfac1, xfac2, xfac3,xfac4,xfac5,xfac6,xfac7,z2 - ! - real(DP) pi, THRD, ee, cc, kk, bb,miu,fac1,small - parameter(pi=3.141592653589793_DP) - parameter(THRD=0.3333333333333333_DP) - parameter(ee=1.537_DP) - parameter(cc=1.59096_DP) - parameter(kk=0.804_DP) - parameter(bb=0.40_DP) - parameter(miu=0.21951_DP) - parameter(fac1=9.57078000062731_DP) !fac1=(3*pi^2)^(2/3) - parameter(small=1.0E-6_DP) - !==------------------------------------------------------------- - tauw=0.125_DP*grho2/rho - z=tauw/tau - - p=sqrt(grho2)/rho**THRD/rho - p=p*p/(fac1*4.0_DP) - tau_unif=0.3_DP*fac1*rho**(5.0_DP/3.0_DP) - al=(tau-tauw)/tau_unif - al=abs(al) !make sure al is always .gt. 0.0_DP - qb=0.45_DP*(al-1.0_DP)/sqrt(1.0_DP+bb*al*(al-1.0_DP)) - qb=qb+2.0_DP*THRD*p - + REAL(DP) xf1, xf2 + REAL(DP) xfac1, xfac2, xfac3, xfac4, xfac5, xfac6, xfac7, z2 + ! + REAL(DP), PARAMETER :: pi=3.141592653589793_DP + REAL(DP), PARAMETER :: THRD=0.3333333333333333_DP + REAL(DP), PARAMETER :: ee=1.537_DP + REAL(DP), PARAMETER :: cc=1.59096_DP + REAL(DP), PARAMETER :: kk=0.804_DP + REAL(DP), PARAMETER :: bb=0.40_DP + REAL(DP), PARAMETER :: miu=0.21951_DP + REAL(DP), PARAMETER :: fac1=9.57078000062731_DP !fac1=(3*pi^2)^(2/3) + REAL(DP), PARAMETER :: small=1.0E-6_DP + ! + tauw = 0.125_DP*grho2/rho + z = tauw/tau + ! + p = SQRT(grho2)/rho**THRD/rho + p = p*p/(fac1*4.0_DP) + tau_unif = 0.3_DP*fac1*rho**(5.0_DP/3.0_DP) + al = (tau-tauw)/tau_unif + al = ABS(al) !make sure al is always .gt. 0.0_DP + qb = 0.45_DP*(al-1.0_DP)/SQRT(1.0_DP+bb*al*(al-1.0_DP)) + qb = qb+2.0_DP*THRD*p + ! ! calculate x(p,z) and fx - z2=z*z - xf1=10.0_DP/81.0_DP - xfac1=xf1+cc*z2/(1+z2)**2.0_DP - xfac2=146.0_DP/2025.0_DP - xfac3=sqrt(0.5_DP*(0.36_DP*z2+p*p)) - xfac4=xf1*xf1/kk - xfac5=2.0_DP*sqrt(ee)*xf1*0.36_DP - xfac6=xfac1*p+xfac2*qb**2.0_DP-73.0_DP/405.0_DP*qb*xfac3 - xfac6=xfac6+xfac4*p**2.0_DP+xfac5*z2+ee*miu*p**3.0_DP - xfac7=(1+sqrt(ee)*p) - x=xfac6/(xfac7*xfac7) + z2 = z*z + xf1 = 10.0_DP/81.0_DP + xfac1 = xf1+cc*z2/(1+z2)**2.0_DP + xfac2 = 146.0_DP/2025.0_DP + xfac3 = SQRT(0.5_DP*(0.36_DP*z2+p*p)) + xfac4 = xf1*xf1/kk + xfac5 = 2.0_DP*SQRT(ee)*xf1*0.36_DP + xfac6 = xfac1*p+xfac2*qb**2.0_DP-73.0_DP/405.0_DP*qb*xfac3 + xfac6 = xfac6+xfac4*p**2.0_DP+xfac5*z2+ee*miu*p**3.0_DP + xfac7 = (1+SQRT(ee)*p) + x = xfac6/(xfac7*xfac7) ! fx=kk-kk/(1.0_DP+x/kk) - fx=1.0_DP + kk-kk/(1.0_DP+x/kk) - + fx = 1.0_DP + kk-kk/(1.0_DP+x/kk) + ! ! calculate the derivatives of fx w.r.t p and z - dfdx=(kk/(kk+x))**2.0_DP - daldp=5.0_DP*THRD*(tau/tauw-1.0_DP) + dfdx = (kk/(kk+x))**2.0_DP + daldp = 5.0_DP*THRD*(tau/tauw-1.0_DP) + ! ! daldz=-0.50_DP*THRD* ! * (tau/(2.0_DP*fac1*rho**THRD*0.1250_DP*sqrt(grho2)))**2.0_DP - daldz=-5.0_DP*THRD*p/z2 - dqbdz=0.45_DP*(0.50_DP*bb*(al-1.0_DP)+1.0_DP) - dqbdz=dqbdz/(1.0_DP+bb*al*(al-1.0_DP))**1.5_DP - - dqbdp=dqbdz*daldp+2.0_DP*THRD - dqbdz=dqbdz*daldz - ! calculate d x /d p - xf1=73.0_DP/405.0_DP/xfac3*0.50_DP*qb - xf2=2.0_DP*xfac2*qb-73.0_DP/405.0_DP*xfac3 - - dxdp=-xf1*p - dxdp=dxdp+xfac1+xf2*dqbdp - dxdp=dxdp+2.0_DP*xfac4*p - dxdp=dxdp+3.0_DP*ee*miu*p*p - dxdp=dxdp/(xfac7*xfac7)-2.0_DP*x*sqrt(ee)/xfac7 - ! d x/ dz - dxdz=-xf1*0.36_DP*z - xfac1=cc*2.0_DP*z*(1-z2)/(1+z2)**3.0_DP - dxdz=dxdz+xfac1*p+xf2*dqbdz - dxdz=dxdz+xfac5*2.0_DP*z - dxdz=dxdz/(xfac7*xfac7) - - fxp=dfdx*dxdp - fxz=dfdx*dxdz + daldz = -5.0_DP*THRD*p/z2 + dqbdz = 0.45_DP*(0.50_DP*bb*(al-1.0_DP)+1.0_DP) + dqbdz = dqbdz/(1.0_DP+bb*al*(al-1.0_DP))**1.5_DP + ! + dqbdp = dqbdz*daldp+2.0_DP*THRD + dqbdz = dqbdz*daldz + ! + ! calculate dx/dp + xf1 = 73.0_DP/405.0_DP/xfac3*0.50_DP*qb + xf2 = 2.0_DP*xfac2*qb-73.0_DP/405.0_DP*xfac3 + ! + dxdp = -xf1*p + dxdp = dxdp+xfac1+xf2*dqbdp + dxdp = dxdp+2.0_DP*xfac4*p + dxdp = dxdp+3.0_DP*ee*miu*p*p + dxdp = dxdp/(xfac7*xfac7)-2.0_DP*x*SQRT(ee)/xfac7 + ! + ! dx/dz + dxdz = -xf1*0.36_DP*z + xfac1 = cc*2.0_DP*z*(1-z2)/(1+z2)**3.0_DP + dxdz = dxdz+xfac1*p+xf2*dqbdz + dxdz = dxdz+xfac5*2.0_DP*z + dxdz = dxdz/(xfac7*xfac7) + ! + fxp = dfdx*dxdp + fxz = dfdx*dxdz + ! ! calculate f1x - localdp=-8.0_DP*THRD*p/rho ! D p /D rho - dz=-z/rho ! D z /D rho - f1x=fxp*localdp+fxz*dz + localdp = -8.0_DP*THRD*p/rho ! D p /D rho + dz = -z/rho ! D z /D rho + f1x = fxp*localdp+fxz*dz + ! ! f2x - localdp=2.0_DP/(fac1*4.0_DP*rho**(8.0_DP/3.0_DP)) - dz=2.0_DP*0.125_DP/(rho*tau) - f2x=fxp*localdp + fxz*dz - ! f3x - localdp=0.0_DP - dz=-z/tau - f3x=fxz*dz - - - return -end subroutine metaFX - -!------------------------------------------------------------------- -subroutine tpsscx_spin(rhoup,rhodw,grhoup2,grhodw2,tauup,taudw,sx,& - v1xup,v1xdw,v2xup,v2xdw,v3xup,v3xdw) - !----------------------------------------------------------------- - ! TPSS metaGGA for exchange - Hartree a.u. + localdp = 2.0_DP/(fac1*4.0_DP*rho**(8.0_DP/3.0_DP)) + dz = 2.0_DP*0.125_DP/(rho*tau) + f2x = fxp*localdp + fxz*dz ! - USE kinds, ONLY : DP - implicit none + ! f3x + localdp = 0.0_DP + dz = -z/tau + f3x = fxz*dz ! - ! dummy arguments + RETURN + ! +END SUBROUTINE metaFX +! +! +!--------------------------------------------------------------------------- +SUBROUTINE tpsscx_spin( rhoup, rhodw, grhoup2, grhodw2, tauup, taudw, sx, & + v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw ) + !----------------------------------------------------------------------- + !! TPSS metaGGA for exchange - Hartree a.u. ! - real(DP) :: rhoup, rhodw, grhoup2, grhodw2, sx, v1xup, v1xdw, & - v2xup, v2xdw - ! up and down charge - ! up and down gradient of the charge - ! exchange and correlation energies - ! derivatives of exchange wr. rho - ! derivatives of exchange wr. grho + USE kinds, ONLY : DP ! - real(DP):: tauup,taudw, &! up and down kinetic energy density - v3xup,v3xdw ! derivatives of exchange wr. tau - real(DP) :: small - parameter (small = 1.E-10_DP) - real(DP) :: rho, sxup, sxdw + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: rhoup + !! up charge + REAL(DP), INTENT(IN) :: rhodw + !! down charge + REAL(DP), INTENT(IN) :: grhoup2 + !! up gradient of the charge + REAL(DP), INTENT(IN) :: grhodw2 + !! down gradient of the charge + REAL(DP), INTENT(OUT) :: sx + !! exchange energy + REAL(DP), INTENT(OUT) :: v1xup + !! derivatives of exchange wr. rho - up + REAL(DP), INTENT(OUT) :: v1xdw + !! derivatives of exchange wr. rho - down + REAL(DP), INTENT(OUT) :: v2xup + !! derivatives of exchange wr. grho - up + REAL(DP), INTENT(OUT) :: v2xdw + !! derivatives of exchange wr. grho - down + REAL(DP), INTENT(OUT) :: tauup + !! up kinetic energy density + REAL(DP), INTENT(OUT) :: taudw + !! down kinetic energy density + REAL(DP), INTENT(OUT) :: v3xup + !! derivatives of exchange wr. tau - up + REAL(DP), INTENT(OUT) :: v3xdw + !! derivatives of exchange wr. tau - down + ! + ! ... local variables + ! + REAL(DP), PARAMETER :: small = 1.E-10_DP + REAL(DP) :: rho, sxup, sxdw ! ! exchange rho = rhoup + rhodw - if (rhoup.gt.small.and.sqrt(abs(grhoup2)).gt.small & - .and. abs(tauup).gt.small) then - call metax(2.0_DP*rhoup,4.0_DP*grhoup2, & - 2.0_DP*tauup,sxup,v1xup,v2xup,v3xup) - else - sxup=0.0_DP - v1xup=0.0_DP - v2xup=0.0_DP - v3xup=0.0_DP - endif - if (rhodw.gt.small.and.sqrt(abs(grhodw2)).gt.small & - .and. abs(taudw).gt.small) then - call metax(2.0_DP*rhodw,4.0_DP*grhodw2, & - 2.0_DP*taudw,sxdw,v1xdw,v2xdw,v3xdw) - else - sxdw=0.0_DP - v1xdw=0.0_DP - v2xdw=0.0_DP - v3xdw=0.0_DP - endif - sx=0.5_DP*(sxup+sxdw) - v2xup=2.0_DP*v2xup - v2xdw=2.0_DP*v2xdw - ! - return -end subroutine tpsscx_spin -! -!----------------------------------------------------------------------- -subroutine tpsscc_spin(rho,zeta,grhoup,grhodw, & - atau,sc,v1cup,v1cdw,v2cup,v2cdw,v3cup, v3cdw) -!----------------------------------------------------------------------- -! tpss metaGGA for correlations - Hartree a.u. -! - USE kinds, ONLY : DP - implicit none -! -! dummy arguments -! - real(DP) :: rho, zeta, grhoup(3),grhodw(3), sc, v1cup, v1cdw, v3c - ! the total charge - ! the magnetization - ! the gradient of the charge - ! exchange and correlation energies - ! derivatives of correlation wr. rho - ! derivatives of correlation wr. grho - - real(DP), dimension(3) :: v2cup, v2cdw, grho_vec - real(DP) :: atau,v3cup, v3cdw, grho !grho=grho2 - real(DP) :: small - integer :: ipol - parameter (small = 1.E-10_DP) - ! - ! -! vector - grho_vec=grhoup+grhodw - grho=0.0_DP - do ipol=1,3 - grho = grho + grho_vec(ipol)**2 - end do + IF (rhoup>small .AND. SQRT(ABS(grhoup2))>small & + .AND. ABS(tauup) > small) THEN + CALL metax( 2.0_DP*rhoup, 4.0_DP*grhoup2, & + 2.0_DP*tauup, sxup, v1xup, v2xup, v3xup ) + ELSE + sxup = 0.0_DP + v1xup = 0.0_DP + v2xup = 0.0_DP + v3xup = 0.0_DP + ENDIF + ! + IF (rhodw > small .AND. SQRT(ABS(grhodw2)) > small & + .AND. ABS(taudw) > small) THEN + CALL metax( 2.0_DP*rhodw, 4.0_DP*grhodw2, & + 2.0_DP*taudw, sxdw, v1xdw, v2xdw, v3xdw ) + ELSE + sxdw = 0.0_DP + v1xdw = 0.0_DP + v2xdw = 0.0_DP + v3xdw = 0.0_DP + ENDIF + ! + sx = 0.5_DP*(sxup+sxdw) + v2xup = 2.0_DP*v2xup + v2xdw = 2.0_DP*v2xdw + ! + RETURN + ! +END SUBROUTINE tpsscx_spin ! ! - if (rho.le.small.or.abs (zeta) .gt.1.0_DP.or.sqrt (abs (grho) ) & - .le.small.or.abs(atau).lt.small) then - - sc = 0.0_DP +!--------------------------------------------------------------------------- +SUBROUTINE tpsscc_spin( rho, zeta, grhoup, grhodw, & + atau, sc, v1cup, v1cdw, v2cup, v2cdw, v3cup, v3cdw ) + !-------------------------------------------------------------------------- + !! TPSS metaGGA for correlations - Hartree a.u. + ! + USE kinds, ONLY : DP + ! + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: rho + !! the total charge + REAL(DP), INTENT(IN) :: zeta + !! the magnetization + REAL(DP), INTENT(IN) :: atau + !! the total kinetic energy density + REAL(DP), INTENT(IN) :: grhoup(3) + !! the gradient of the charge - up + REAL(DP), INTENT(IN) :: grhodw(3) + !! the gradient of the charge - down + REAL(DP), INTENT(OUT) :: sc + !! correlation energy + REAL(DP), INTENT(OUT) :: v1cup + !! derivatives of correlation wr. rho - up + REAL(DP), INTENT(OUT) :: v1cdw + !! derivatives of correlation wr. rho - down + REAL(DP), INTENT(OUT) :: v2cup(3) + !! derivatives of correlation wr. grho - up + REAL(DP), INTENT(OUT) :: v2cdw(3) + !! derivatives of correlation wr. grho - down + REAL(DP), INTENT(OUT) :: v3cup + !! derivatives of correlation wr. tau - up + REAL(DP), INTENT(OUT) :: v3cdw + !! derivatives of correlation wr. tau - down + ! + ! ... local variables + ! + REAL(DP) :: grho_vec(3) + REAL(DP) :: v3c, grho !grho=grho2 + INTEGER :: ipol + REAL(DP), PARAMETER :: small = 1.E-10_DP + ! + ! vector + grho_vec = grhoup + grhodw + grho = 0.0_DP + ! + DO ipol = 1, 3 + grho = grho + grho_vec(ipol)**2 + ENDDO + ! + IF (rho <= small .OR. ABS(zeta) > 1.0_DP .OR. SQRT(ABS(grho)) <= small & + .OR. ABS(atau) < small ) THEN + ! + sc = 0.0_DP v1cup = 0.0_DP v1cdw = 0.0_DP - + ! v2cup(:) = 0.0_DP v2cdw(:) = 0.0_DP - + ! v3cup = 0.0_DP v3cdw = 0.0_DP - + ! v3c = 0.0_DP - - else - call metac_spin(rho,zeta,grhoup,grhodw, & - atau,sc,v1cup,v1cdw,v2cup,v2cdw,v3c) - end if - ! + ELSE + CALL metac_spin( rho, zeta, grhoup, grhodw, & + atau, sc, v1cup, v1cdw, v2cup, v2cdw, v3c ) + ENDIF ! v3cup = v3c v3cdw = v3c ! - return -end subroutine tpsscc_spin + RETURN + ! +END SUBROUTINE tpsscc_spin ! ! !--------------------------------------------------------------- @@ -498,11 +559,31 @@ SUBROUTINE metac_spin( rho, zeta, grhoup, grhodw, & ! IMPLICIT NONE ! - ! input - REAL(DP) :: rho, zeta, grhoup(3), grhodw(3), tau - ! output - REAL(DP) :: sc, v1up, v1dw, v2up(3), v2dw(3), v3 - ! local + REAL(DP), INTENT(IN) :: rho + !! the total charge + REAL(DP), INTENT(IN) :: zeta + !! the magnetization + REAL(DP), INTENT(IN) :: grhoup(3) + !! the gradient of the charge - up + REAL(DP), INTENT(IN) :: grhodw(3) + !! the gradient of the charge - down + REAL(DP), INTENT(IN) :: tau + !! the total kinetic energy density + REAL(DP), INTENT(OUT) :: sc + !! correlation energy + REAL(DP), INTENT(OUT) :: v1up + !! derivatives of correlation wr. rho - up + REAL(DP), INTENT(OUT) :: v1dw + !! derivatives of correlation wr. rho - down + REAL(DP), INTENT(OUT) :: v2up(3) + !! derivatives of correlation wr. grho - up + REAL(DP), INTENT(OUT) :: v2dw(3) + !! derivatives of correlation wr. grho - down + REAL(DP), INTENT(OUT) :: v3 + !! derivatives of correlation wr. tau + ! + ! ... local variables + ! REAL(DP) :: rhoup, rhodw, tauw, grhovec(3), grho2, grho, & grhoup2, grhodw2 ! @@ -778,17 +859,10 @@ SUBROUTINE metac_spin( rho, zeta, grhoup, grhodw, & ! END SUBROUTINE metac_spin ! -!------------------------------------------------------------------------- -! ! END TPSSS -!------------------------------------------------------------------------- -! !========================================================================= ! -!------------------------------------------------------------------------- -! -! M06L -! +! --- M06L --- ! ! input: - rho ! - grho2=|\nabla rho|^2 @@ -806,137 +880,154 @@ END SUBROUTINE metac_spin ! ec, v1c, v2c, v3c as above for correlation ! !------------------------------------------------------------------------- -! -subroutine m06lxc (rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c) - +SUBROUTINE m06lxc( rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c ) !----------------------------------------------------------------------- - ! - ! - USE kinds, ONLY : dp - - implicit none - - real(dp), intent(in) :: rho, grho2, tau - real(dp), intent(out) :: ex, ec, v1x, v2x,v3x,v1c,v2c,v3c ! - real(dp) :: rhoa, rhob, grho2a, grho2b, taua, taub, v1cb, v2cb, v3cb - real(dp), parameter :: zero = 0.0_dp, two = 2.0_dp, four = 4.0_dp - ! - ! - rhoa = rho / two ! one component only - rhob = rhoa + USE kinds, ONLY : DP + ! + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: rho + !! the total charge + REAL(DP), INTENT(IN) :: grho2 + !! square of gradient of rho + REAL(DP), INTENT(IN) :: tau + !! the total kinetic energy density + REAL(DP), INTENT(OUT) :: ex + !! exchange energy + REAL(DP), INTENT(OUT) :: ec + !! correlation energy + REAL(DP), INTENT(OUT) :: v1x + !! derivatives of exchange wr. rho + REAL(DP), INTENT(OUT) :: v2x + !! derivatives of exchange wr. grho + REAL(DP), INTENT(OUT) :: v3x + !! derivatives of exchange wr. tau + REAL(DP), INTENT(OUT) :: v1c + !! derivatives of correlation wr. rho + REAL(DP), INTENT(OUT) :: v2c + !! derivatives of correlation wr. grho + REAL(DP), INTENT(OUT) :: v3c + !! derivatives of correlation wr. tau + ! + ! ... local variables + ! + REAL(DP) :: rhoa, rhob, grho2a, grho2b, taua, taub, v1cb, v2cb, v3cb + REAL(DP), PARAMETER :: zero = 0.0_dp, two = 2.0_dp, four = 4.0_dp + ! + ! + rhoa = rho / two ! one component only + rhob = rhoa ! grho2a = grho2 / four grho2b = grho2a ! - taua = tau * two * 0.5_dp ! Taua, which is Tau_sigma is half Tau - taub = taua ! Tau is defined as summ_i( |nabla phi_i|**2 ) + taua = tau * two * 0.5_dp ! Taua, which is Tau_sigma is half Tau + taub = taua ! Tau is defined as summ_i( |nabla phi_i|**2 ) ! in the M06L routine ! - call m06lx (rhoa, grho2a, taua, ex, v1x, v2x, v3x) + CALL m06lx( rhoa, grho2a, taua, ex, v1x, v2x, v3x ) ! - ex = two * ex ! Add the two components up + dw + ex = two * ex ! Add the two components up + dw ! v2x = 0.5_dp * v2x ! - call m06lc (rhoa, rhob, grho2a, grho2b, taua, taub, ec, v1c, v2c, v3c, & - & v1cb, v2cb, v3cb) - ! + CALL m06lc( rhoa, rhob, grho2a, grho2b, taua, taub, ec, v1c, v2c, v3c, & + v1cb, v2cb, v3cb ) ! v2c = 0.5_dp * v2c ! -end subroutine m06lxc - -!------------------------------------------------------------------------- +END SUBROUTINE m06lxc +! ! -subroutine m06lxc_spin (rhoup, rhodw, grhoup2, grhodw2, tauup, taudw, & - & ex, ec, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, & - & v1cup, v1cdw, v2cup, v2cdw, v3cup, v3cdw) - +!------------------------------------------------------------------------- +SUBROUTINE m06lxc_spin( rhoup, rhodw, grhoup2, grhodw2, tauup, taudw, & + ex, ec, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, & + v1cup, v1cdw, v2cup, v2cdw, v3cup, v3cdw ) !----------------------------------------------------------------------- ! + USE kinds, ONLY : DP ! - USE kinds, ONLY : dp - - implicit none - - real(dp), intent(in) :: rhoup, rhodw, grhoup2, grhodw2, tauup, taudw - real(dp), intent(out) :: ex, ec, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, & - & v1cup, v1cdw, v2cup, v2cdw, v3cup, v3cdw + IMPLICIT NONE ! - real(dp) :: exup, exdw, taua, taub - real(dp), parameter :: zero = 0.0_dp, two = 2.0_dp + REAL(DP), INTENT(IN) :: rhoup, rhodw, grhoup2, grhodw2, tauup, taudw + REAL(DP), INTENT(OUT) :: ex, ec, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, & + v1cup, v1cdw, v2cup, v2cdw, v3cup, v3cdw ! + REAL(DP) :: exup, exdw, taua, taub + REAL(DP), PARAMETER :: zero = 0.0_dp, two = 2.0_dp ! + taua = tauup * two ! Tau is defined as summ_i( |nabla phi_i|**2 ) + taub = taudw * two ! in the rest of the routine ! - taua = tauup * two ! Tau is defined as summ_i( |nabla phi_i|**2 ) - taub = taudw * two ! in the rest of the routine - ! - call m06lx (rhoup, grhoup2, taua, exup, v1xup, v2xup, v3xup) - call m06lx (rhodw, grhodw2, taub, exdw, v1xdw, v2xdw, v3xdw) + CALL m06lx( rhoup, grhoup2, taua, exup, v1xup, v2xup, v3xup ) + CALL m06lx( rhodw, grhodw2, taub, exdw, v1xdw, v2xdw, v3xdw ) ! ex = exup + exdw ! + CALL m06lc( rhoup, rhodw, grhoup2, grhodw2, taua, taub, & + ec, v1cup, v2cup, v3cup, v1cdw, v2cdw, v3cdw ) ! - call m06lc (rhoup, rhodw, grhoup2, grhodw2, taua, taub, & - & ec, v1cup, v2cup, v3cup, v1cdw, v2cdw, v3cdw) - ! +END SUBROUTINE m06lxc_spin +! +! +!=============================== M06L exchange ========================== +! +!------------------------------------------------------------------------------- +SUBROUTINE m06lx( rho, grho2, tau, ex, v1x, v2x, v3x ) + !--------------------------------------------------------------------------- + !! M06L exchange. ! + USE kinds, ONLY : DP + USE constants, ONLY : pi ! -end subroutine m06lxc_spin - - -!=============================== M06L exchange ========================== - - -subroutine m06lx (rho, grho2, tau, ex, v1x, v2x, v3x) - -!_________________________________________________________________________ - - use kinds, ONLY : dp - use constants, ONLY : pi - - implicit none - - real(dp), intent(in) :: rho, grho2, tau - real(dp), intent(out) :: ex, v1x, v2x, v3x - - real(dp) :: v1x_unif,ex_unif, ex_pbe, & - & sx_pbe, v1x_pbe, v2x_pbe + IMPLICIT NONE ! - ! ex_unif: lda \epsilon_x(rho) + REAL(DP), INTENT(IN) :: rho + !! the total charge + REAL(DP), INTENT(IN) :: grho2 + !! square of gradient of rho + REAL(DP), INTENT(IN) :: tau + !! the total kinetic energy density + REAL(DP), INTENT(OUT) :: ex + !! exchange energy + REAL(DP), INTENT(OUT) :: v1x + !! derivatives of exchange wr. rho + REAL(DP), INTENT(OUT) :: v2x + !! derivatives of exchange wr. grho + REAL(DP), INTENT(OUT) :: v3x + !! derivatives of exchange wr. tau + ! + ! ... local variables + ! + REAL(DP) :: v1x_unif, ex_unif, ex_pbe, sx_pbe, v1x_pbe, v2x_pbe + ! ex_unif: lda \epsilon_x(rho) ! v2x = 1/|grho| * dsx / d|grho| = 2 * dsx / dgrho2 ! - real(dp), parameter :: zero = 0._dp, one = 1.0_dp, two=2.0_dp, three = 3.0_dp, & - & four = 4.0_dp, five = 5.0_dp, six = 6.0_dp, & - & eight = 8.0_dp, & - & f12 = one/two, f13 = one/three, f23 = two/three, & - & f53 = five/three, f83 = eight/three, f43 = four/three, & - & pi34 = pi*three/four, pi2 = pi*pi, & - & small=1.d-10 - - real(dp) :: d0, d1, d2, d3, d4, d5, CF, CT, CX, alpha - real(dp), dimension(0:11) & - & :: at - integer :: i + REAL(DP), PARAMETER :: zero = 0._dp, one = 1.0_dp, two = 2.0_dp, three = 3.0_dp, & + four = 4.0_dp, five = 5.0_dp, six = 6.0_dp, eight = 8.0_dp, & + f12 = one/two, f13 = one/three, f23 = two/three, & + f53 = five/three, f83 = eight/three, f43 = four/three, & + pi34 = pi*three/four, pi2 = pi*pi, small = 1.d-10 + ! + REAL(DP) :: d0, d1, d2, d3, d4, d5, CF, CT, CX, alpha + REAL(DP), DIMENSION(0:11) :: at + INTEGER :: i ! - ! ! VSXC98 variables (LDA part) ! - real(dp) :: xs, xs2, grho, rhom83, rho13, rho43, zs, gh - real(dp) :: hg, dhg_dxs2, dhg_dzs - real(dp) :: dxs2_drho, dxs2_dgrho2, dzs_drho, dzs_dtau - real(dp) :: ex_vs98, v1x_vs98, v2x_vs98, v3x_vs98, v2x_vs98_g + REAL(DP) :: xs, xs2, grho, rhom83, rho13, rho43, zs, gh + REAL(DP) :: hg, dhg_dxs2, dhg_dzs + REAL(DP) :: dxs2_drho, dxs2_dgrho2, dzs_drho, dzs_dtau + REAL(DP) :: ex_vs98, v1x_vs98, v2x_vs98, v3x_vs98, v2x_vs98_g ! ! GGA and MGGA variables ! - real(dp) :: tau_unif, ts, ws, fws, dfws, dfws_drho, dfws_dtau, & - & dws_dts, dts_dtau, dts_drho + REAL(DP) :: tau_unif, ts, ws, fws, dfws, dfws_drho, dfws_dtau, & + dws_dts, dts_dtau, dts_drho ! - ! _________________________________________________________________________________________ - ! set parameters - + ! at(0) = 3.987756d-01 at(1) = 2.548219d-01 at(2) = 3.923994d-01 @@ -949,161 +1040,159 @@ subroutine m06lx (rho, grho2, tau, ex, v1x, v2x, v3x) at(9) = 2.160364d+01 at(10) = 3.421814d+01 at(11) = -9.049762d+00 - + ! d0 = 6.012244d-01 d1 = 4.748822d-03 d2 = -8.635108d-03 d3 = -9.308062d-06 d4 = 4.482811d-05 d5 = zero - + ! alpha = 1.86726d-03 -!___________________________________________________ - - if (rho < small .and. tau < small) then - ex = zero - v1x = zero - v2x = zero - v3x = zero - return - - end if - -! _________VSXC98 functional (LDA part)_____________ -! -! set variables - - - CF = (three/five) * (six*pi2)**f23 - CT = CF / two - CX = -(three/two) * (three/(four*pi))**f13 ! Cx LSDA - -! if (rho >= small .and. grho>=small) then - - grho = sqrt(grho2) + ! + IF (rho < small .AND. tau < small) THEN + ex = zero + v1x = zero + v2x = zero + v3x = zero + RETURN + ENDIF + ! + ! ... VSXC98 functional (LDA part) + ! + ! set variables + ! + CF = (three/five) * (six*pi2)**f23 + CT = CF / two + CX = -(three/two) * (three/(four*pi))**f13 ! Cx LSDA + ! + ! IF (rho >= small .AND. grho>=small) THEN + ! + grho = SQRT(grho2) rho43 = rho**f43 rho13 = rho**f13 - rhom83 = one/rho**f83 + rhom83 = one / rho**f83 + ! xs = grho / rho43 xs2 = xs * xs - zs = tau/rho**f53 - CF + zs = tau / rho**f53 - CF gh = one + alpha * (xs2 + zs) - - - if (gh >= small) then - call gvt4 (xs2, zs, d0, d1, d2, d3, d4, d5, alpha, hg, dhg_dxs2, dhg_dzs) - else - hg = zero - dhg_dxs2 = zero - dhg_dzs = zero - end if - + ! + IF (gh >= small) THEN + CALL gvt4( xs2, zs, d0, d1, d2, d3, d4, d5, alpha, hg, dhg_dxs2, dhg_dzs ) + ELSE + hg = zero + dhg_dxs2 = zero + dhg_dzs = zero + ENDIF + ! dxs2_drho = -f83*xs2/rho dxs2_dgrho2 = rhom83 - dzs_drho = -f53*tau*rhom83 - dzs_dtau = one/rho**f53 - - ex_unif = CX * rho43 - ex_vs98 = ex_unif * hg - v1x_vs98 = CX * ( f43 * hg * rho**f13 ) + & -& ex_unif * ( dhg_dxs2*dxs2_drho + dhg_dzs*dzs_drho ) - v2x_vs98 = two * ex_unif * dhg_dxs2 * dxs2_dgrho2 - v3x_vs98 = ex_unif * dhg_dzs * dzs_dtau - -!____________________mo6lx functional____________________________ - - tau_unif = CF * rho**f53 ! Tau is define as summ_i( |nabla phi_i|**2 ) - ts = tau_unif / tau - ws = (ts - one)/(ts + one) - - fws = zero - dfws = zero - - do i = 0, 11 + dzs_drho = -f53*tau*rhom83 + dzs_dtau = one/rho**f53 + ! + ex_unif = CX * rho43 + ex_vs98 = ex_unif * hg + v1x_vs98 = CX * ( f43 * hg * rho**f13 ) + & + ex_unif * ( dhg_dxs2*dxs2_drho + dhg_dzs*dzs_drho ) + v2x_vs98 = two * ex_unif * dhg_dxs2 * dxs2_dgrho2 + v3x_vs98 = ex_unif * dhg_dzs * dzs_dtau + ! + ! ... mo6lx functional + ! + tau_unif = CF * rho**f53 ! Tau is define as summ_i( |nabla phi_i|**2 ) + ts = tau_unif / tau + ws = (ts - one)/(ts + one) + ! + fws = zero + dfws = zero + ! + DO i = 0, 11 fws = fws + at(i)*ws**i dfws = dfws + i*at(i)*ws**(i-1) - end do - - dws_dts = two/((ts+1)**2) - dts_drho = ( (six*pi*pi*rho)**f23 )/tau - dts_dtau = -ts/tau + ENDDO + ! + dws_dts = two/((ts+1)**2) + dts_drho = ( (six*pi*pi*rho)**f23 )/tau + dts_dtau = -ts/tau dfws_drho = dfws*dws_dts*dts_drho dfws_dtau = dfws*dws_dts*dts_dtau - - call pbex_m06l (two*rho, four*grho2, sx_pbe, v1x_pbe, v2x_pbe) - + ! + CALL pbex_m06l( two*rho, four*grho2, sx_pbe, v1x_pbe, v2x_pbe ) + ! v1x_unif = f43 * CX * rho13 - - sx_pbe = f12 * sx_pbe - v1x_pbe = v1x_pbe + v1x_unif - v2x_pbe = two * v2x_pbe - - - ex_pbe = sx_pbe + ex_unif - -!________energy and potential_____________________________ - - ex = ex_vs98 + ex_pbe*fws - + ! + sx_pbe = f12 * sx_pbe + v1x_pbe = v1x_pbe + v1x_unif + v2x_pbe = two * v2x_pbe + ! + ex_pbe = sx_pbe + ex_unif + ! + ! ... energy and potential + ! + ex = ex_vs98 + ex_pbe*fws + ! v1x = v1x_vs98 + v1x_pbe*fws + ex_pbe*dfws_drho v2x = v2x_vs98 + v2x_pbe*fws v3X = v3x_vs98 + ex_pbe*dfws_dtau - -!__________________________________________________________ - -end subroutine m06lx - -!__________________________________________________________ - -subroutine pbex_m06l (rho, grho2, sx, v1x, v2x) - - !--------------------------------------------------------------- ! - ! PBE exchange (without Slater exchange): - ! J.P.Perdew, K.Burke, M.Ernzerhof, PRL 77, 3865 (1996) +END SUBROUTINE m06lx +! +! +!------------------------------------------------------------------- +SUBROUTINE pbex_m06l( rho, grho2, sx, v1x, v2x ) + !--------------------------------------------------------------- + !! PBE exchange (without Slater exchange): + !! J.P.Perdew, K.Burke, M.Ernzerhof, PRL 77, 3865 (1996). ! - ! v2x = 1/|grho| * dsx / d|grho| = 2 * dsx / dgrho2 + !! v2x = 1/|grho| * dsx / d|grho| = 2 * dsx / dgrho2 ! USE kinds - USE constants, ONLY : pi - - implicit none - - real(dp) :: rho, grho2, sx, v1x, v2x - ! input: charge and squared gradient - ! output: energy - ! output: potential - integer :: iflag - - ! local variables - real(dp) :: grho, rho43, xs, xs2, dxs2_drho, dxs2_dgrho2 - real(dp) :: CX, denom, C1, C2, ex, Fx, dFx_dxs2, dex_drho - - real(dp), parameter :: mu=0.21951_dp, ka=0.804_dp, one = 1.0_dp, two=2.0_dp, three = 3.0_dp, & - & four = 4.0_dp, six = 6.0_dp, eight = 8.0_dp, & - & f13 = one/three, f23 = two/three, f43 = four/three, & - & f34=three/four, f83 = eight/three - -!_____________________________________________________________________ - + USE constants, ONLY : pi + ! + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: rho + !! charge density + REAL(DP), INTENT(IN) :: grho2 + !! squared gradient + REAL(DP), INTENT(OUT) :: sx + !! energy + REAL(DP), INTENT(OUT) :: v1x + !! potential w.r. rho + REAL(DP), INTENT(OUT) :: v2x + !! potential w.r. grho + ! + ! ... local variables + ! + INTEGER :: iflag + REAL(DP) :: grho, rho43, xs, xs2, dxs2_drho, dxs2_dgrho2 + REAL(DP) :: CX, denom, C1, C2, ex, Fx, dFx_dxs2, dex_drho + ! + REAL(DP), PARAMETER :: mu = 0.21951_dp, ka = 0.804_dp, & + one = 1.0_dp, two = 2.0_dp, three = 3.0_dp, & + four = 4.0_dp, six = 6.0_dp, eight = 8.0_dp, & + f13 = one/three, f23 = two/three, f43 = four/three, & + f34 = three/four, f83 = eight/three + ! CX = f34 * (three/pi)**f13 ! Cx LDA denom = four * (three*pi**two)**f23 C1 = mu / denom C2 = mu / (ka * denom) - - grho = sqrt(grho2) + ! + grho = SQRT(grho2) rho43 = rho**f43 xs = grho / rho43 xs2 = xs * xs - - dxs2_drho = -f83 * xs2 / rho + ! + dxs2_drho = -f83 * xs2 / rho dxs2_dgrho2 = one /rho**f83 - - ex = - CX * rho43 - dex_drho = - f43 * CX * rho**f13 - - Fx = C1*xs2 / (one + C2*xs2) - dFx_dxs2 = C1 / (one + C2*xs2)**2 + ! + ex = - CX * rho43 + dex_drho = - f43 * CX * rho**f13 + ! + Fx = C1*xs2 / (one + C2*xs2) + dFx_dxs2 = C1 / (one + C2*xs2)**2 ! ! Energy ! @@ -1114,120 +1203,140 @@ subroutine pbex_m06l (rho, grho2, sx, v1x, v2x) v1x = dex_drho * Fx + ex * dFx_dxs2 * dxs2_drho v2x = two * ex * dFx_dxs2* dxs2_dgrho2 ! - ! -end subroutine pbex_m06l - - -!=============================== M06L correlation ========================== -! -!------------------------------------------------------------------------- +END SUBROUTINE pbex_m06l +! ! -subroutine m06lc(rhoa, rhob, grho2a, grho2b, taua, taub, ec, v1c_up, v2c_up, v3c_up, & -& v1c_dw, v2c_dw, v3c_dw) -!------------------------------------------------------------------------- +!=============================== M06L correlation ========================== ! - - use kinds, only : dp - use constants, only : pi - implicit none -!------------------------------------------------------------------------- - - real(dp), intent(in) :: rhoa, rhob, grho2a, grho2b, taua, taub - real(dp), intent(out) :: ec, v1c_up, v2c_up, v3c_up, v1c_dw, v2c_dw, v3c_dw +!--------------------------------------------------------------------------------- +SUBROUTINE m06lc( rhoa, rhob, grho2a, grho2b, taua, taub, ec, v1c_up, v2c_up, & + v3c_up, v1c_dw, v2c_dw, v3c_dw ) + !------------------------------------------------------------------------------- + !! M06L correlation. ! - real(DP) :: rs, zeta - real(DP) :: vc_v(2) + USE kinds, ONLY : DP + USE constants, ONLY : pi ! + IMPLICIT NONE ! - real(dp), parameter :: zero = 0._dp, one = 1.0_dp, two=2.0_dp, three = 3.0_dp, & - & four = 4.0_dp, five = 5.0_dp, six = 6.0_dp, & - & eight = 8.0_dp, & - & f12 = one/two, f13 = one/three, f23 = two/three, & - & f53 = five/three, f83 = eight/three, f43 = four/three, & - & pi34 = three/(four*pi), pi2 = pi*pi, f35 = three/five, & - & small=1.d-10 + REAL(DP), INTENT(IN) :: rhoa + !! charge density up + REAL(DP), INTENT(IN) :: rhob + !! charge density down + REAL(DP), INTENT(IN) :: grho2a + !! squared gradient up + REAL(DP), INTENT(IN) :: grho2b + !! squared gradient down + REAL(DP), INTENT(IN) :: taua + !! kinetic energy density up + REAL(DP), INTENT(IN) :: taub + !! kinetic energyt density down + REAL(DP), INTENT(OUT) :: ec + !! correlation energy + REAL(DP), INTENT(OUT) :: v1c_up + !! corr. potential w.r. rho - up + REAL(DP), INTENT(OUT) :: v2c_up + !! corr. potential w.r. rho - up + REAL(DP), INTENT(OUT) :: v3c_up + !! corr. potential w.r. rho - up + REAL(DP), INTENT(OUT) :: v1c_dw + !! corr. potential w.r. rho - down + REAL(DP), INTENT(OUT) :: v2c_dw + !! corr. potential w.r. grho - down + REAL(DP), INTENT(OUT) :: v3c_dw + !! corr. potential w.r. tau - down + ! + ! ... local variables + ! + REAL(DP) :: rs, zeta + REAL(DP) :: vc_v(2) + ! + REAL(DP), PARAMETER :: zero = 0._dp, one = 1.0_dp, two = 2.0_dp, three = 3.0_dp, & + four = 4.0_dp, five = 5.0_dp, six = 6.0_dp, eight = 0.0_dp, & + f12 = one/two, f13 = one/three, f23 = two/three, & + f53 = five/three, f83 = eight/three, f43 = four/three, & + pi34 = three/(four*pi), pi2 = pi*pi, f35 = three/five, & + small = 1.d-10 ! ! parameters of the MO6Lc functional ! - real(dp), dimension(0:4):: cs, cab + REAL(DP), DIMENSION(0:4):: cs, cab ! - real(dp) :: ds0, ds1, ds2, ds3, ds4, ds5, CF, alpha, Ds, & - & dab0, dab1, dab2, dab3, dab4, dab5, gama_ab, gama_s, & - & alpha_s, alpha_ab + REAL(DP) :: ds0, ds1, ds2, ds3, ds4, ds5, CF, alpha, Ds, & + dab0, dab1, dab2, dab3, dab4, dab5, gama_ab, gama_s, & + alpha_s, alpha_ab ! ! functions and variables ! - real(dp) :: ec_pw_a, ec_pw_b, ec_pw_ab + REAL(DP) :: ec_pw_a, ec_pw_b, ec_pw_ab + ! + REAL(DP) :: vv, vc_pw_a, vc_pw_b, vc_pw_ab, vc_pw_up, vc_pw_dw, Ecaa, Ecbb, Ecab, & + Ec_UEG_ab, Ec_UEG_aa, Ec_UEG_bb, decab_drhoa, decab_drhob, & + v1_ab_up, v1_ab_dw, v2_ab_up, v2_ab_dw, v3_ab_up, v3_ab_dw, & + v1_aa_up, v2_aa_up, v3_aa_up, v1_bb_dw, v2_bb_dw, v3_bb_dw + ! + REAL(DP) :: xsa, xs2a, rsa, grhoa, xsb, xs2b, grhob, rsb, zsa, zsb, & + xs2ab, zsab, rho, & + dxs2a_drhoa, dxs2b_drhob, dxs2a_dgrhoa2, dxs2b_dgrhob2, & + dzsa_drhoa, dzsb_drhob, dzsa_dtaua, dzsb_dtaub + ! + REAL(DP) :: hga, dhga_dxs2a, dhga_dzsa, hgb, dhgb_dxs2b, dhgb_dzsb, & + hgab, dhgab_dxs2ab, dhgab_dzsab, & + Dsa, Dsb, dDsa_dxs2a, dDsa_dzsa, dDsb_dxs2b, dDsb_dzsb, & + gsa, gsb, gsab, dgsa_dxs2a, dgsb_dxs2b, dgsab_dxs2ab, num + ! + INTEGER :: ifunc + ! + ! + dab0 = 3.957626d-01 + dab1 = -5.614546d-01 + dab2 = 1.403963d-02 + dab3 = 9.831442d-04 + dab4 = -3.577176d-03 + dab5 = zero + ! + cab(0) = 6.042374d-01 + cab(1) = 1.776783d+02 + cab(2) = -2.513252d+02 + cab(3) = 7.635173d+01 + cab(4) = -1.255699d+01 + ! + gama_ab = 0.0031_dp + alpha_ab = 0.00304966_dp + ! + ds0 = 4.650534d-01 + ds1 = 1.617589d-01 + ds2 = 1.833657d-01 + ds3 = 4.692100d-04 + ds4 = -4.990573d-03 + ds5 = zero ! - real(dp) :: vv, vc_pw_a, vc_pw_b, vc_pw_ab, vc_pw_up, vc_pw_dw, Ecaa, Ecbb, Ecab, & - & Ec_UEG_ab, Ec_UEG_aa, Ec_UEG_bb, decab_drhoa, decab_drhob, & - & v1_ab_up, v1_ab_dw, v2_ab_up, v2_ab_dw, v3_ab_up, v3_ab_dw, & - & v1_aa_up, v2_aa_up, v3_aa_up, v1_bb_dw, v2_bb_dw, v3_bb_dw + cs(0) = 5.349466d-01 + cs(1) = 5.396620d-01 + cs(2) = -3.161217d+01 + cs(3) = 5.149592d+01 + cs(4) = -2.919613d+01 + ! + gama_s = 0.06_dp + alpha_s = 0.00515088_dp + ! + CF = f35 * (six*pi2)**f23 ! - real(dp) :: xsa, xs2a, rsa, grhoa, xsb, xs2b, grhob, rsb, zsa, zsb, & - & xs2ab, zsab, rho, & - & dxs2a_drhoa, dxs2b_drhob, dxs2a_dgrhoa2, dxs2b_dgrhob2, & - & dzsa_drhoa, dzsb_drhob, dzsa_dtaua, dzsb_dtaub - ! - real(dp) :: hga, dhga_dxs2a, dhga_dzsa, hgb, dhgb_dxs2b, dhgb_dzsb, & - & hgab, dhgab_dxs2ab, dhgab_dzsab, & - & Dsa, Dsb, dDsa_dxs2a, dDsa_dzsa, dDsb_dxs2b, dDsb_dzsb, & - & gsa, gsb, gsab, dgsa_dxs2a, dgsb_dxs2b, dgsab_dxs2ab, num - - integer :: ifunc - -!_____________________________________________________________________________________ - - dab0 = 3.957626d-01 - dab1 = -5.614546d-01 - dab2 = 1.403963d-02 - dab3 = 9.831442d-04 - dab4 = -3.577176d-03 - dab5 = zero - - cab(0) = 6.042374d-01 - cab(1) = 1.776783d+02 - cab(2) = -2.513252d+02 - cab(3) = 7.635173d+01 - cab(4) = -1.255699d+01 - - gama_ab = 0.0031_dp - alpha_ab = 0.00304966_dp - - - ds0 = 4.650534d-01 - ds1 = 1.617589d-01 - ds2 = 1.833657d-01 - ds3 = 4.692100d-04 - ds4 = -4.990573d-03 - ds5 = zero - - cs(0) = 5.349466d-01 - cs(1) = 5.396620d-01 - cs(2) = -3.161217d+01 - cs(3) = 5.149592d+01 - cs(4) = -2.919613d+01 - - gama_s = 0.06_dp - alpha_s = 0.00515088_dp - - CF = f35 * (six*pi2)**f23 - ifunc = 1 ! iflag=1 J.P. Perdew and Y. Wang, PRB 45, 13244 (1992) - -!______________Ecaa_____________________________________________________ - - if (rhoa < small .and. taua < small ) then + ! + ! ... Ecaa + ! + IF (rhoa < small .AND. taua < small) THEN ! - Ecaa = zero + Ecaa = zero v1_aa_up = zero v2_aa_up = zero v3_aa_up = zero ! - else + ELSE ! rsa = (pi34/rhoa)**f13 - grhoa = sqrt(grho2a) + grhoa = SQRT(grho2a) xsa = grhoa / rhoa**f43 xs2a = xsa * xsa zsa = taua/rhoa**f53 - CF @@ -1247,42 +1356,42 @@ subroutine m06lc(rhoa, rhob, grho2a, grho2b, taua, taub, ec, v1c_up, v2c_up, v3c ! rs = rsa zeta = one - call pw_spin( rs, zeta, ec_pw_a, vc_v ) + CALL pw_spin( rs, zeta, ec_pw_a, vc_v ) vc_pw_a = vc_v(1) vv = vc_v(2) ! - call gvt4 (xs2a, zsa, ds0, ds1, ds2, ds3, ds4, ds5, alpha_s, hga, dhga_dxs2a, dhga_dzsa) - call gfunc (cs, gama_s, xs2a, gsa, dgsa_dxs2a) + CALL gvt4( xs2a, zsa, ds0, ds1, ds2, ds3, ds4, ds5, alpha_s, hga, dhga_dxs2a, dhga_dzsa ) + CALL gfunc( cs, gama_s, xs2a, gsa, dgsa_dxs2a ) ! - Ec_UEG_aa = rhoa*ec_pw_a - num = (dgsa_dxs2a + dhga_dxs2a)*Dsa + (gsa + hga)*dDsa_dxs2a + Ec_UEG_aa = rhoa*ec_pw_a + num = (dgsa_dxs2a + dhga_dxs2a)*Dsa + (gsa + hga)*dDsa_dxs2a ! ! - Ecaa = Ec_UEG_aa * (gsa + hga) * Dsa - - v1_aa_up = vc_pw_a * (gsa + hga) * Dsa & - & + Ec_UEG_aa * num * dxs2a_drhoa & - & + Ec_UEG_aa * (dhga_dzsa*Dsa + (gsa + hga)*dDsa_dzsa) * dzsa_drhoa - - v2_aa_up = two * Ec_UEG_aa * num * dxs2a_dgrhoa2 - - v3_aa_up = Ec_UEG_aa * (dhga_dzsa*Dsa + (gsa + hga)*dDsa_dzsa) * dzsa_dtaua + Ecaa = Ec_UEG_aa * (gsa + hga) * Dsa ! - end if -! -!______________Ecbb_____________________________________________________ - - if (rhob < small .and. taub < small) then - - Ecbb = zero + v1_aa_up = vc_pw_a * (gsa + hga) * Dsa + & + Ec_UEG_aa * num * dxs2a_drhoa + & + Ec_UEG_aa * (dhga_dzsa*Dsa + (gsa + hga)*dDsa_dzsa) * dzsa_drhoa + ! + v2_aa_up = two * Ec_UEG_aa * num * dxs2a_dgrhoa2 + ! + v3_aa_up = Ec_UEG_aa * (dhga_dzsa*Dsa + (gsa + hga)*dDsa_dzsa) * dzsa_dtaua + ! + ENDIF + ! + ! ... Ecbb + ! + IF (rhob < small .AND. taub < small) THEN + ! + Ecbb = zero v1_bb_dw = zero v2_bb_dw = zero v3_bb_dw = zero - - else - + ! + ELSE + ! rsb = (pi34/rhob)**f13 - grhob = sqrt(grho2b) + grhob = SQRT(grho2b) xsb = grhob / rhob**f43 xs2b = xsb * xsb zsb = taub/rhob**f53 - CF @@ -1290,492 +1399,160 @@ subroutine m06lc(rhoa, rhob, grho2a, grho2b, taua, taub, ec, v1c_up, v2c_up, v3c dxs2b_drhob = -f83*xs2b/rhob dxs2b_dgrhob2 = one /rhob**f83 - dzsb_drhob = -f53*taub/(rhob**f83) - dzsb_dtaub = one/rhob**f53 + dzsb_drhob = -f53*taub/(rhob**f83) + dzsb_dtaub = one/rhob**f53 Dsb = one - xs2b/(four * (zsb + CF)) dDsb_dxs2b = - one/(four * (zsb + CF)) dDsb_dzsb = xs2b/(four * (zsb + CF)**2) ! - zeta = one - rs = rsb - call pw_spin( rs, zeta, ec_pw_b, vc_v ) + zeta = one + rs = rsb + CALL pw_spin( rs, zeta, ec_pw_b, vc_v ) vc_pw_b = vc_v(1) vv = vc_v(2) ! - call gvt4 (xs2b, zsb, ds0, ds1, ds2, ds3, ds4, ds5, alpha_s, hgb, dhgb_dxs2b, dhgb_dzsb) - call gfunc (cs, gama_s, xs2b, gsb, dgsb_dxs2b) - - Ec_UEG_bb = rhob*ec_pw_b - num = (dgsb_dxs2b + dhgb_dxs2b)*Dsb + (gsb + hgb)*dDsb_dxs2b + CALL gvt4( xs2b, zsb, ds0, ds1, ds2, ds3, ds4, ds5, alpha_s, hgb, dhgb_dxs2b, dhgb_dzsb ) + CALL gfunc( cs, gama_s, xs2b, gsb, dgsb_dxs2b ) ! - ! - Ecbb = Ec_UEG_bb * (gsb + hgb) * Dsb - - v1_bb_dw = vc_pw_b * (gsb + hgb) * Dsb & - & + Ec_UEG_bb * num * dxs2b_drhob & - & + Ec_UEG_bb * (dhgb_dzsb*Dsb + (gsb + hgb)*dDsb_dzsb)*dzsb_drhob - - v2_bb_dw = two * Ec_UEG_bb * num * dxs2b_dgrhob2 - - v3_bb_dw = Ec_UEG_bb * (dhgb_dzsb*Dsb + (gsb + hgb)*dDsb_dzsb)*dzsb_dtaub + Ec_UEG_bb = rhob*ec_pw_b + num = (dgsb_dxs2b + dhgb_dxs2b)*Dsb + (gsb + hgb)*dDsb_dxs2b ! - end if -! -!________________Ecab____________________________________________ - - if (rhoa < small .and. rhob < small) then - - Ecab = zero + Ecbb = Ec_UEG_bb * (gsb + hgb) * Dsb + ! + v1_bb_dw = vc_pw_b * (gsb + hgb) * Dsb + & + Ec_UEG_bb * num * dxs2b_drhob + & + Ec_UEG_bb * (dhgb_dzsb*Dsb + (gsb + hgb)*dDsb_dzsb)*dzsb_drhob + ! + v2_bb_dw = two * Ec_UEG_bb * num * dxs2b_dgrhob2 + ! + v3_bb_dw = Ec_UEG_bb * (dhgb_dzsb*Dsb + (gsb + hgb)*dDsb_dzsb)*dzsb_dtaub + ! + ENDIF + ! + ! ... Ecab + ! + IF (rhoa < small .AND. rhob < small) THEN + ! + Ecab = zero v1_ab_up = zero v1_ab_dw = zero v2_ab_up = zero v2_ab_dw = zero v3_ab_up = zero v3_ab_dw = zero - - else - + ! + ELSE + ! xs2ab = xs2a + xs2b zsab = zsa + zsb rho = rhoa + rhob zeta = (rhoa - rhob)/rho rs = (pi34/rho)**f13 - - call gvt4(xs2ab, zsab, dab0, dab1, dab2, dab3, dab4, dab5, alpha_ab, hgab, dhgab_dxs2ab, dhgab_dzsab) ! - call pw_spin( rs, zeta, ec_pw_ab, vc_v ) - vc_pw_up = vc_v(1) ; vc_pw_dw=vc_v(2) + CALL gvt4( xs2ab, zsab, dab0, dab1, dab2, dab3, dab4, dab5, alpha_ab, hgab, & + dhgab_dxs2ab, dhgab_dzsab ) ! - call gfunc(cab, gama_ab, xs2ab, gsab, dgsab_dxs2ab) + CALL pw_spin( rs, zeta, ec_pw_ab, vc_v ) + vc_pw_up=vc_v(1) ; vc_pw_dw=vc_v(2) ! - decab_drhoa = vc_pw_up - vc_pw_a - decab_drhob = vc_pw_dw - vc_pw_b - - Ec_UEG_ab = ec_pw_ab*rho - ec_pw_a*rhoa - ec_pw_b*rhob + CALL gfunc( cab, gama_ab, xs2ab, gsab, dgsab_dxs2ab ) ! + decab_drhoa = vc_pw_up - vc_pw_a + decab_drhob = vc_pw_dw - vc_pw_b ! - Ecab = Ec_UEG_ab * (gsab + hgab) + Ec_UEG_ab = ec_pw_ab*rho - ec_pw_a*rhoa - ec_pw_b*rhob + ! + Ecab = Ec_UEG_ab * (gsab + hgab) - v1_ab_up = decab_drhoa * (gsab + hgab) & - & + Ec_UEG_ab * (dgsab_dxs2ab + dhgab_dxs2ab) * dxs2a_drhoa & - & + Ec_UEG_ab * dhgab_dzsab * dzsa_drhoa - - v1_ab_dw = decab_drhob * (gsab + hgab) & - & + Ec_UEG_ab * (dgsab_dxs2ab + dhgab_dxs2ab) * dxs2b_drhob & - & + Ec_UEG_ab * dhgab_dzsab * dzsb_drhob - + v1_ab_up = decab_drhoa * (gsab + hgab) + & + Ec_UEG_ab * (dgsab_dxs2ab + dhgab_dxs2ab) * dxs2a_drhoa + & + Ec_UEG_ab * dhgab_dzsab * dzsa_drhoa + ! + v1_ab_dw = decab_drhob * (gsab + hgab) + & + Ec_UEG_ab * (dgsab_dxs2ab + dhgab_dxs2ab) * dxs2b_drhob + & + Ec_UEG_ab * dhgab_dzsab * dzsb_drhob + ! v2_ab_up = two * Ec_UEG_ab * (dgsab_dxs2ab + dhgab_dxs2ab) * dxs2a_dgrhoa2 v2_ab_dw = two * Ec_UEG_ab * (dgsab_dxs2ab + dhgab_dxs2ab) * dxs2b_dgrhob2 v3_ab_up = Ec_UEG_ab * dhgab_dzsab * dzsa_dtaua v3_ab_dw = Ec_UEG_ab * dhgab_dzsab * dzsb_dtaub ! - end if -! -!___________________ec and vc_____________________________________________ - - ec = Ecaa + Ecbb + Ecab - + ENDIF + ! + ! ... ec and vc + ! + ec = Ecaa + Ecbb + Ecab + ! v1c_up = v1_aa_up + v1_ab_up v2c_up = v2_aa_up + v2_ab_up v3c_up = v3_aa_up + v3_ab_up - + ! v1c_dw = v1_bb_dw + v1_ab_dw v2c_dw = v2_bb_dw + v2_ab_dw v3c_dw = v3_bb_dw + v3_ab_dw - -!__________________________________________________________________________ - - contains -!__________________________________________________________________________ - - subroutine gfunc (cspin, gama, xspin, gs, dgs_dx) - - implicit none - real(dp), dimension (0:4), intent(in) :: cspin - real(dp), intent(in) :: xspin, gama - real(dp), intent(out) :: gs, dgs_dx + ! + CONTAINS + ! + !------------------------------------------------------------------- + SUBROUTINE gfunc( cspin, gama, xspin, gs, dgs_dx ) + !----------------------------------------------------------------- + ! + IMPLICIT NONE ! - real(dp) :: de, d2, x1, x2, x3, x4 - real(dp), parameter :: one=1.0d0, two=2.0d0, three=3.0d0, four=4.0d0 - - !__________________ - - de = one/(one + gama*xspin) + REAL(DP), INTENT(IN) :: cspin(0:4) + REAL(DP), INTENT(IN) :: xspin, gama + REAL(DP), INTENT(OUT) :: gs, dgs_dx + ! + REAL(DP) :: de, d2, x1, x2, x3, x4 + REAL(DP), PARAMETER :: one=1.0d0, two=2.0d0, & + three=3.0d0, four=4.0d0 + ! + de = one/(one + gama*xspin) d2 = de**2 x1 = gama * xspin * de x2 = x1**2 x3 = x1**3 x4 = x1**4 - - gs = cspin(0) + cspin(1)*x1 + cspin(2)*x2 + cspin(3)*x3 + cspin(4)*x4 - dgs_dx = gama*d2* (cspin(1) + two*cspin(2)*x1 + three*cspin(3)*x2 + four*cspin(4)*x3) - - end subroutine gfunc - - !___________________________________________________________________ - -end subroutine m06lc - -!___________________________________________________________________ - - -subroutine gvt4 (x, z, a, b, c, d, e, f, alpha, hg, dh_dx, dh_dz) - - use kinds, only : dp - - implicit none - - real(dp), intent(in) :: X, z, a, b, c, d, e, f, alpha - real(dp), intent(out) :: hg, dh_dx, dh_dz - - real(dp) :: gamma, gamma2, gamma3 - real(dp), parameter :: one=1.0_dp, two=2.0_dp, three=3.0_dp - - gamma = one + alpha*(x+z) - gamma2 = gamma*gamma - gamma3 = gamma2*gamma - - hg = a/gamma + (b*x + c*z)/gamma2 + (d*x*x + e*x*z + f*z*z)/gamma3 - - dh_dx = ( -alpha*a + b + (two*x*(d - alpha*b) + z*(e - two*alpha*c))/ gamma & -& - three*alpha*(d*x*x + e*x*z + f*z*z)/gamma2 )/gamma2 - - dh_dz = ( -alpha*a + c + (two*z*(f - alpha*c) + x*(e -two*alpha*b))/ gamma & -& - three*alpha*(d*x*x + e*x*z + f*z*z)/gamma2 )/gamma2 - - return - -end subroutine gvt4 - -!------------------------------------------------------------------------- -! -! END M06L + ! + gs = cspin(0) + cspin(1)*x1 + cspin(2)*x2 + cspin(3)*x3 + cspin(4)*x4 + dgs_dx = gama*d2*(cspin(1) + two*cspin(2)*x1 + three*cspin(3)*x2 + four*cspin(4)*x3) + ! + END SUBROUTINE gfunc + ! +END SUBROUTINE m06lc ! -!========================================================================= ! -! TB09 -!----------------------------------------------------------------------- - -subroutine tb09cxc(rho, grho, tau, sx, sc, v1x, v2x,v3x,v1c, v2c,v3c) - - USE kinds, ONLY : DP -#if defined(__LIBXC) - use xc_f90_types_m - use xc_f90_lib_m -#endif - implicit none - real(DP), intent(in) :: rho, grho, tau - real(dp), intent(out):: sx, sc, v1x, v2x, v3x, v1c, v2c, v3c -#if defined(__LIBXC) - TYPE(xc_f90_pointer_t) :: xc_func - TYPE(xc_f90_pointer_t) :: xc_info - integer :: size = 1 - integer :: func_id = 208 !Tran & Blaha correction to Becke & Johnson - real(dp) :: lapl_rho, vlapl_rho ! not used in TB09 - - lapl_rho = grho - - ! ---------------------------- Exchange - - func_id = 208 !Tran & Blaha correction to Becke & Johnson -- TB09 - - call xc_f90_func_init(xc_func, xc_info, func_id, XC_UNPOLARIZED) - call xc_f90_mgga_vxc(xc_func, size, rho, grho, lapl_rho, tau, & - v1x, v2x, vlapl_rho, v3x) - call xc_f90_func_end(xc_func) - - sx = sx * rho - v2x = v2x*2.0_dp - - ! ---------------------------- Correlation - - func_id = 231 ! Perdew, Tao, Staroverov & Scuseria correlation -- TPSS - - call xc_f90_func_init(xc_func, xc_info, func_id, XC_UNPOLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, size, rho, grho, lapl_rho, tau, & - sc, v1c, v2c, vlapl_rho, v3c) - call xc_f90_func_end(xc_func) - - sc = sc * rho - v2c = v2c*2.0_dp -#else - sx=0.0_dp; sc=0.0_dp; v1x=0.0_dp; v2x=0.0_dp; v3x=0.0_dp; v1c=0.0_dp; v2c=0.0_dp; v3c=0.0_dp - call errore('tb09','need libxc',1) -#endif -end subroutine tb09cxc - -!c ================================================================== - - - - -!====================================================================== -! SCAN meta-GGA -!====================================================================== -subroutine SCANcxc(rho, grho, tau, sx, sc, v1x, v2x, v3x, v1c, v2c, v3c) - USE kinds, ONLY : DP -#if defined(__LIBXC) - use xc_f90_types_m - use xc_f90_lib_m -#endif - implicit none - real(DP), intent(in) :: rho, grho, tau - real(dp), intent(out):: sx, sc, v1x, v2x, v3x, v1c, v2c, v3c - -#if defined(__LIBXC) - TYPE(xc_f90_pointer_t) :: xc_func - TYPE(xc_f90_pointer_t) :: xc_info - integer :: size = 1 - integer :: func_id - real(dp) :: lapl_rho, vlapl_rho ! not used? - - lapl_rho = grho - - ! exchange - func_id = 263 ! XC_MGGA_X_SCAN - - call xc_f90_func_init(xc_func, xc_info, func_id, XC_UNPOLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, size, rho, grho, lapl_rho, tau,& - sx, v1x, v2x, vlapl_rho, v3x) - call xc_f90_func_end(xc_func) - - sx = sx * rho - v2x = v2x*2.0_dp - - ! correlation - func_id = 267 ! XC_MGGA_C_SCAN - call xc_f90_func_init(xc_func, xc_info, func_id, XC_UNPOLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, size, rho, grho, lapl_rho, tau, & - sc, v1c, v2c, vlapl_rho, v3c) - call xc_f90_func_end(xc_func) - - sc = sc * rho - v2c = v2c*2.0_dp - -#else - call errore('SCAN meta-GGA','need LibXC v.3.0.1 or later',1) -#endif - -end subroutine SCANcxc - -subroutine scanxc_spin( rhoup, rhodw, grhoup, grhodw, tauup, taudw, & - & sx, v1xup,v1xdw,v2xup,v2xdw,v3xup,v3xdw, & - & sc, v1cup,v1cdw,v2cup,v2cdw,v3cup,v3cdw ) - !----------------------------------------------------------------------- - ! SCAN metaGGA corrections for exchange and correlation - Hartree a.u. - ! - ! input: rho, grho=|\nabla rho|^2, tau = kinetic energy density - ! definition: E_x = \int E_x(rho,grho) dr - ! output: sx = E_x(rho,grho) - ! v1x= D(E_x)/D(rho) - ! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| - ! sc, v1c, v2c as above for correlation - ! v3x= D(E_x)/D(tau) - ! - USE kinds, ONLY : DP -#if defined(__LIBXC) - use xc_f90_types_m - use xc_f90_lib_m -#endif - implicit none - real(DP), intent(in) :: rhoup, rhodw, grhoup(3), grhodw(3), tauup, taudw - real(dp), intent(out):: sx, v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, & - & sc, v1cup, v1cdw, v2cup(3), v2cdw(3), v3cup, v3cdw -#if defined(__LIBXC) - ! - ! Internal Variables - ! - TYPE(xc_f90_pointer_t) :: xc_func - TYPE(xc_f90_pointer_t) :: xc_info - integer :: size = 1, ipol - integer :: func_id - ! - ! Format compatible with Libxc - ! - real(dp) :: rho(2), grho2(3), tau(2), v1x(2), v2x(3), v3x(2), & - & v1c(2), v2c(3), v3c(2), lapl_rho(6), vlapl_rho(6) - ! - rho(1) = rhoup - rho(2) = rhodw - ! - ! Contracted gradients of density - ! - grho2 = 0_DP - do ipol = 1,3 - ! - grho2(1) = grho2(1) + grhoup(ipol)**2 - grho2(2) = grho2(2) + grhoup(ipol) * grhodw(ipol) - grho2(3) = grho2(3) + grhodw(ipol)**2 - ! - enddo - ! - tau(1) = tauup - tau(2) = taudw - ! - ! exchange - ! - func_id = 263 - call xc_f90_func_init(xc_func, xc_info, func_id, XC_POLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, size, rho(1), grho2(1), lapl_rho(1), tau(1),& - sx, v1x(1), v2x(1), vlapl_rho(1), v3x(1)) - call xc_f90_func_end(xc_func) - ! - ! correlation - ! - func_id = 267 - call xc_f90_func_init(xc_func, xc_info, func_id, XC_POLARIZED) - call xc_f90_mgga_exc_vxc(xc_func,size , rho(1), grho2(1), lapl_rho(1), tau(1),& - sc, v1c(1), v2c(1), vlapl_rho(1), v3c(1)) - call xc_f90_func_end(xc_func) - ! - ! from libxc to QE format - ! - sx = sx * ( rho(1) + rho(2) ) - v1xup = v1x(1) - v2xup = v2x(1) * 2.D0 - v3xup = v3x(1) - v1xdw = v1x(2) - v2xdw = v2x(3) * 2.D0 - v3xdw = v3x(2) - ! - sc = sc * ( rho(1) + rho(2) ) - v1cup = v1c(1) - v3cup = v3c(1) - v1cdw = v1c(2) - v3cdw = v3c(2) - ! - ! cross terms of v2c(2). v2x(2) is always zero. - ! - do ipol = 1,3 - ! - v2cup(ipol) = v2c(1)*grhoup(ipol) * 2.D0 + v2c(2)*grhodw(ipol) - v2cdw(ipol) = v2c(3)*grhodw(ipol) * 2.D0 + v2c(2)*grhoup(ipol) - ! - enddo - ! -#else - call errore('SCAN meta-GGA','need LibXC v.3.0.1 or later',1) -#endif - return - ! -end subroutine scanxc_spin - -subroutine scancxc_array(nnr, rho, grho, tau, sx, sc, v1x, v2x, v3x, v1c, v2c, v3c ) - !----------------------------------------------------------------------- - ! SCAN metaGGA corrections for exchange and correlation - Hartree a.u. - ! - ! input: rho, grho=|\nabla rho|^2, tau = kinetic energy density - ! definition: E_x = \int E_x(rho,grho) dr - ! output: sx = E_x(rho,grho) - ! v1x= D(E_x)/D(rho) - ! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| - ! sc, v1c, v2c as above for correlation - ! v3x= D(E_x)/D(tau) +!------------------------------------------------------------------------- +SUBROUTINE gvt4( x, z, a, b, c, d, e, f, alpha, hg, dh_dx, dh_dz ) + !---------------------------------------------------------------------- ! - USE kinds, ONLY : DP -#if defined(__LIBXC) - use xc_f90_types_m - use xc_f90_lib_m -#endif - implicit none - integer, intent(in) :: nnr - real(dp), intent(in) :: rho(nnr), grho(nnr), tau(nnr) - real(dp), intent(out):: sx(nnr), sc(nnr), v1x(nnr), v2x(nnr), v3x(nnr) - real(dp), intent(out):: v1c(nnr), v2c(nnr), v3c(nnr) -#if defined(__LIBXC) - ! - TYPE(xc_f90_pointer_t) :: xc_func - TYPE(xc_f90_pointer_t) :: xc_info - integer :: func_id - real(dp) :: lapl_rho(nnr), vlapl_rho(nnr) ! not used in TPSS - - lapl_rho = grho - - ! exchange - func_id = 263 - call xc_f90_func_init(xc_func, xc_info, func_id, XC_UNPOLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, nnr, rho(1), grho(1), lapl_rho(1), tau(1),& - sx(1), v1x(1), v2x(1), vlapl_rho(1), v3x(1)) - call xc_f90_func_end(xc_func) - - sx = sx * rho - v2x = v2x * 2.D0 ! MCA/HK: for libxc compatibility - - ! correlation - func_id = 267 - call xc_f90_func_init(xc_func, xc_info, func_id, XC_UNPOLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, nnr, rho(1), grho(1), lapl_rho(1), tau(1),& - & sc(1), v1c(1), v2c(1), vlapl_rho(1), v3c(1)) - call xc_f90_func_end(xc_func) - - sc = sc * rho - v2c = v2c * 2.D0 - -#else - call errore('SCAN meta-GGA','need LibXC v.3.0.1 or later',1) -#endif - ! - return -end subroutine scancxc_array - -subroutine scancxc_array_spin(nnr, rho, grho2, tau, sx, sc, v1x, v2x, v3x, v1c, v2c, v3c ) - !----------------------------------------------------------------------- - ! SCAN metaGGA corrections for exchange and correlation - Hartree a.u. + USE kinds, ONLY : DP ! - ! input: rho, grho=|\nabla rho|^2, tau = kinetic energy density - ! definition: E_x = \int E_x(rho,grho) dr - ! output: sx = E_x(rho,grho) - ! v1x= D(E_x)/D(rho) - ! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| - ! sc, v1c, v2c as above for correlation - ! v3x= D(E_x)/D(tau) + IMPLICIT NONE ! - USE kinds, ONLY : DP -#if defined(__LIBXC) - use xc_f90_types_m - use xc_f90_lib_m -#endif - implicit none - integer, intent(in) :: nnr - real(dp), intent(in) :: rho(2,nnr), grho2(3,nnr), tau(2,nnr) - real(dp), intent(out):: sx(nnr), sc(nnr), v1x(2,nnr), v2x(3,nnr), v3x(2,nnr) - real(dp), intent(out):: v1c(2,nnr), v2c(3,nnr), v3c(2,nnr) -#if defined(__LIBXC) - ! - TYPE(xc_f90_pointer_t) :: xc_func - TYPE(xc_f90_pointer_t) :: xc_info - integer :: func_id - real(dp) :: lapl_rho(nnr,3,2), vlapl_rho(nnr,3,2) ! not used in SCAN - - lapl_rho = 0.D0 ! not used in SCAN - - ! exchange + REAL(DP), INTENT(IN) :: X, z, a, b, c, d, e, f, alpha + REAL(DP), INTENT(OUT) :: hg, dh_dx, dh_dz ! - func_id = 263 + REAL(DP) :: gamma, gamma2, gamma3 + REAL(DP), PARAMETER :: one=1.0_dp, two=2.0_dp, three=3.0_dp ! - call xc_f90_func_init(xc_func, xc_info, func_id, XC_POLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, nnr, rho(1,1), grho2(1,1), lapl_rho(1,1,1),& - tau(1,1), sx(1), v1x(1,1), v2x(1,1), vlapl_rho(1,1,1), v3x(1,1)) - call xc_f90_func_end(xc_func) - ! - sx = sx * ( rho(1,:) + rho(2,:) ) - v2x = v2x * 2.D0 ! MCA/HK: for libxc compatibility + gamma = one + alpha*(x+z) + gamma2 = gamma*gamma + gamma3 = gamma2*gamma ! - ! correlation - func_id = 267 - call xc_f90_func_init(xc_func, xc_info, func_id, XC_POLARIZED) - call xc_f90_mgga_exc_vxc(xc_func, nnr, rho(1,1), grho2(1,1), lapl_rho(1,1,1),& - tau(1,1), sc(1), v1c(1,1), v2c(1,1), vlapl_rho(1,1,1), v3c(1,1)) - call xc_f90_func_end(xc_func) + hg = a/gamma + (b*x + c*z)/gamma2 + (d*x*x + e*x*z + f*z*z)/gamma3 ! - sc = sc * ( rho(1,:) + rho(2,:) ) - v2c = v2c * 2.D0 ! MCA/HK: for libxc compatibility + dh_dx = ( -alpha*a + b + (two*x*(d - alpha*b) + z*(e - two*alpha*c))/ gamma & + - three*alpha*(d*x*x + e*x*z + f*z*z)/gamma2 )/gamma2 ! -#else - call errore('SCAN meta-GGA','need LibXC v.3.0.1 or later',1) -#endif + dh_dz = ( -alpha*a + c + (two*z*(f - alpha*c) + x*(e -two*alpha*b))/ gamma & + - three*alpha*(d*x*x + e*x*z + f*z*z)/gamma2 )/gamma2 ! - return -end subroutine scancxc_array_spin + RETURN + ! +END SUBROUTINE gvt4 +! +! END M06L +!========================================================================= diff --git a/Modules/xc_mgga_drivers.f90 b/Modules/xc_mgga_drivers.f90 new file mode 100644 index 0000000000..2369dfcddc --- /dev/null +++ b/Modules/xc_mgga_drivers.f90 @@ -0,0 +1,420 @@ +MODULE xc_mgga +! +USE kinds, ONLY: DP +! +IMPLICIT NONE +! +PRIVATE +SAVE +! +! GGA exchange-correlation drivers +PUBLIC :: xc_metagcx +PUBLIC :: tau_xc, tau_xc_spin +PUBLIC :: change_threshold_mgga, select_mgga_functionals +! +PUBLIC :: libxc_switches_mgga +PUBLIC :: imeta_l, imetac_l +PUBLIC :: exx_started_mg, exx_fraction_mg +! +! libxc on/off +INTEGER :: libxc_switches_mgga(2) +! +! indexes defining xc functionals +INTEGER :: imeta_l, imetac_l +! +! input thresholds (default values) +REAL(DP) :: rho_threshold = 1.0E-8_DP +REAL(DP) :: grho2_threshold = 1.0E-12_DP +REAL(DP) :: tau_threshold = 1.0E-8_DP +! +! variables for hybrid exchange +LOGICAL :: exx_started_mg +REAL(DP) :: exx_fraction_mg +! +! + CONTAINS +! +! +!---------------------------------------------------------------------------- +!----- Select functionals by the corresponding indexes ---------------------- +!---------------------------------------------------------------------------- +SUBROUTINE select_mgga_functionals( imeta, imetac, exx_fraction ) + !----------------------------------------------------------------------------- + ! + IMPLICIT NONE + ! + INTEGER, INTENT(IN) :: imeta, imetac + REAL(DP), INTENT(IN), OPTIONAL :: exx_fraction + ! + ! exchange-correlation indexes + imeta_l = imeta + imetac_l = imetac + ! + ! hybrid exchange vars + exx_started_mg = .FALSE. + exx_fraction_mg = 0._DP + IF ( PRESENT(exx_fraction) ) THEN + exx_started_mg = .TRUE. + exx_fraction_mg = exx_fraction + ENDIF + ! + RETURN + ! +END SUBROUTINE select_mgga_functionals +! +! +! +!------------------------------------------------------------------------------------- +SUBROUTINE change_threshold_mgga( rho_thr_in, grho2_thr_in, tau_thr_in ) + !------------------------------------------------------------------------------------ + !! Change rho, grho and tau thresholds. + ! + REAL(DP), INTENT(IN) :: rho_thr_in + REAL(DP), INTENT(IN), OPTIONAL :: grho2_thr_in + REAL(DP), INTENT(IN), OPTIONAL :: tau_thr_in + ! + rho_threshold = rho_thr_in + IF ( PRESENT(grho2_thr_in) ) grho2_threshold = grho2_thr_in + IF ( PRESENT(tau_thr_in) ) tau_threshold = tau_thr_in + ! + RETURN + ! +END SUBROUTINE change_threshold_mgga +! +! +! +!---------------------------------------------------------------------------------------- +SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c ) + !------------------------------------------------------------------------------------- + !! Wrapper routine. Calls metaGGA drivers from internal libraries + !! of q-e or from the external libxc, depending on the input choice. + ! +#if defined(__LIBXC) + USE xc_f90_types_m + USE xc_f90_lib_m +#endif + ! + IMPLICIT NONE + ! + INTEGER, INTENT(IN) :: length + !! length of the I/O arrays + INTEGER, INTENT(IN) :: ns + !! spin components + INTEGER, INTENT(IN) :: np + !! first dimension of v2c + REAL(DP), INTENT(IN) :: rho(length,ns) + !! the charge density + REAL(DP), INTENT(IN) :: grho(3,length,ns) + !! grho = \nabla rho + REAL(DP), INTENT(IN) :: tau(length,ns) + !! kinetic energy density + REAL(DP), INTENT(OUT) :: ex(length) + !! sx = E_x(rho,grho) + REAL(DP), INTENT(OUT) :: ec(length) + !! sc = E_c(rho,grho) + REAL(DP), INTENT(OUT) :: v1x(length,ns) + !! v1x = D(E_x)/D(rho) + REAL(DP), INTENT(OUT) :: v2x(length,ns) + !! v2x = D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| + REAL(DP), INTENT(OUT) :: v3x(length,ns) + !! v3x = D(E_x)/D(tau) + REAL(DP), INTENT(OUT) :: v1c(length,ns) + !! v1c = D(E_c)/D(rho) + REAL(DP), INTENT(OUT) :: v2c(np,length,ns) + !! v2c = D(E_c)/D( D rho/D r_alpha ) / |\nabla rho| + REAL(DP), INTENT(OUT) :: v3c(length,ns) + !! v3c = D(E_c)/D(tau) + ! + ! ... local variables + ! + INTEGER :: is + REAL(DP), ALLOCATABLE :: grho2(:,:) + ! +#if defined(__LIBXC) + TYPE(xc_f90_pointer_t) :: xc_func + TYPE(xc_f90_pointer_t) :: xc_info1, xc_info2 + ! + REAL(DP), ALLOCATABLE :: rho_lxc(:), sigma(:), tau_lxc(:) + REAL(DP), ALLOCATABLE :: ex_lxc(:), ec_lxc(:) + REAL(DP), ALLOCATABLE :: vx_rho(:), vx_sigma(:), vx_tau(:) + REAL(DP), ALLOCATABLE :: vc_rho(:), vc_sigma(:), vc_tau(:) + REAL(DP), ALLOCATABLE :: lapl_rho(:), vlapl_rho(:) ! not used in TPSS + ! + INTEGER :: k, ipol, pol_unpol + LOGICAL :: POLARIZED + ! + POLARIZED = .FALSE. + IF (ns == 2) THEN + POLARIZED = .TRUE. + ENDIF + ! + pol_unpol = ns + ! + ALLOCATE( rho_lxc(length*ns), sigma(length*ns), tau_lxc(length*ns) ) + ALLOCATE( lapl_rho(length*ns) ) + ! + ALLOCATE( ex_lxc(length) , ec_lxc(length) ) + ALLOCATE( vx_rho(length*ns) , vx_sigma(length*ns), vx_tau(length*ns) ) + ALLOCATE( vc_rho(length*ns) , vc_sigma(length*ns), vc_tau(length*ns) ) + ALLOCATE( vlapl_rho(length*ns) ) + ! + ! + IF ( ns == 1 ) THEN + ! + DO k = 1, length + rho_lxc(k) = ABS( rho(k,1) ) + IF ( rho_lxc(k) > rho_threshold ) & + sigma(k) = grho(1,k,1)**2 + grho(2,k,1)**2 + grho(3,k,1)**2 + tau_lxc(k) = tau(k,1) + ENDDO + ! + ELSE + ! + DO k = 1, length + rho_lxc(2*k-1) = rho(k,1) + rho_lxc(2*k) = rho(k,2) + ! + sigma(3*k-2) = grho(1,k,1)**2 + grho(2,k,1)**2 + grho(3,k,1)**2 + sigma(3*k-1) = grho(1,k,1) * grho(1,k,2) + grho(2,k,1) * grho(2,k,2) + & + grho(3,k,1) * grho(3,k,2) + sigma(3*k) = grho(1,k,2)**2 + grho(2,k,2)**2 + grho(3,k,2)**2 + ! + tau_lxc(2*k-1) = tau(k,1) + tau_lxc(2*k) = tau(k,2) + ENDDO + ! + ENDIF + ! + IF (SUM(libxc_switches_mgga(:)) /= 2) THEN + ! + ALLOCATE( grho2(length,ns) ) + ! + DO is = 1, ns + grho2(:,is) = grho(1,:,is)**2 + grho(2,:,is)**2 + grho(3,:,is)**2 + ENDDO + ! + IF (ns == 1) THEN + CALL tau_xc( length, rho(:,1), grho2(:,1), tau(:,1), ex, ec, v1x(:,1), & + v2x(:,1), v3x(:,1), v1c(:,1), v2c(1,:,1), v3c(:,1) ) + ELSEIF (ns == 2) THEN + CALL tau_xc_spin( length, rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, & + v2c, v3c ) + ENDIF + ! + DEALLOCATE( grho2 ) + ! + ENDIF + ! + ! META EXCHANGE + ! + IF (libxc_switches_mgga(1) == 1) THEN + CALL xc_f90_func_init( xc_func, xc_info1, imeta_l, pol_unpol ) + CALL xc_f90_mgga_exc_vxc( xc_func, length, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), & + ex_lxc(1), vx_rho(1), vx_sigma(1), vlapl_rho(1), vx_tau(1) ) + CALL xc_f90_func_end( xc_func ) + ! + IF (.NOT. POLARIZED) THEN + DO k = 1, length + ex(k) = ex_lxc(k) * rho_lxc(k) + v1x(k,1) = vx_rho(k) + v2x(k,1) = vx_sigma(k) * 2.0_DP + v3x(k,1) = vx_tau(k) + ENDDO + ELSE + DO k = 1, length + ex(k) = ex_lxc(k) * (rho_lxc(2*k-1)+rho_lxc(2*k)) + v1x(k,1) = vx_rho(2*k-1) + v1x(k,2) = vx_rho(2*k) + v2x(k,1) = vx_sigma(3*k-2)*2.d0 + v2x(k,2) = vx_sigma(3*k)*2.d0 + v3x(k,1) = vx_tau(2*k-1) + v3x(k,2) = vx_tau(2*k) + ENDDO + ENDIF + ! + ENDIF + ! + ! META CORRELATION + ! + IF ( libxc_switches_mgga(2) == 1 ) THEN + ! + CALL xc_f90_func_init( xc_func, xc_info1, imetac_l, pol_unpol ) + CALL xc_f90_mgga_exc_vxc( xc_func, length, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), & + ec_lxc(1), vc_rho(1), vc_sigma(1), vlapl_rho(1), vc_tau(1) ) + CALL xc_f90_func_end( xc_func ) + ! + IF (.NOT. POLARIZED) THEN + DO k = 1, length + ec(k) = ec_lxc(k) * rho_lxc(k) !* SIGN(1.0_DP, rho(k,1)) + v1c(k,1) = vc_rho(k) + v2c(1,k,1) = vc_sigma(k) * 2.0_DP + v3c(k,1) = vc_tau(k) + ENDDO + ELSE + DO k = 1, length + ec(k) = ec_lxc(k) * (rho_lxc(2*k-1)+rho_lxc(2*k)) + v1c(k,1) = vc_rho(2*k-1) + v1c(k,2) = vc_rho(2*k) + DO ipol = 1, 3 + v2c(ipol,k,1) = vc_sigma(3*k-2)*grho(ipol,k,1)*2.D0 + vc_sigma(3*k-1)*grho(ipol,k,2) + v2c(ipol,k,2) = vc_sigma(3*k) *grho(ipol,k,2)*2.D0 + vc_sigma(3*k-1)*grho(ipol,k,1) + ENDDO + v3c(k,1) = vc_tau(2*k-1) + v3c(k,2) = vc_tau(2*k) + ENDDO + ENDIF + ! + ENDIF + ! + DEALLOCATE( rho_lxc, sigma, tau_lxc, lapl_rho ) + DEALLOCATE( ex_lxc , ec_lxc ) + DEALLOCATE( vx_rho , vx_sigma, vx_tau ) + DEALLOCATE( vc_rho , vc_sigma, vc_tau, vlapl_rho ) + ! +#else + ! + ALLOCATE( grho2(length,ns) ) + ! + DO is = 1, ns + grho2(:,is) = grho(1,:,is)**2 + grho(2,:,is)**2 + grho(3,:,is)**2 + ENDDO + ! + IF (ns == 1) THEN + ! + CALL tau_xc( length, rho(:,1), grho2(:,1), tau(:,1), ex, ec, v1x(:,1), & + v2x(:,1), v3x(:,1), v1c(:,1), v2c(1,:,1), v3c(:,1) ) + ! + ELSEIF (ns == 2) THEN + ! + CALL tau_xc_spin( length, rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, & + v2c, v3c ) + ! + ENDIF + ! + DEALLOCATE( grho2 ) + ! +#endif + ! + RETURN + ! +END SUBROUTINE xc_metagcx +! +! +!--------------------------------------------------------------------------------- +SUBROUTINE tau_xc( length, rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c ) + !------------------------------------------------------------------------------- + ! gradient corrections for exchange and correlation - Hartree a.u. + ! See comments at the beginning of module for implemented cases + ! + ! input: rho, grho=|\nabla rho|^2 + ! + ! definition: E_x = \int e_x(rho,grho) dr + ! + ! output: sx = e_x(rho,grho) = grad corr + ! v1x= D(E_x)/D(rho) + ! v2x= D(E_x)/D( D rho/D r_alpha ) / |\nabla rho| + ! v3x= D(E_x)/D(tau) + ! + ! sc, v1c, v2c as above for correlation + ! + IMPLICIT NONE + ! + INTEGER, INTENT(IN) :: length + ! + INTEGER :: k + REAL(DP) :: arho + REAL(DP), DIMENSION(length) :: rho, grho2, tau, & + ex, ec, v1x, v2x, v3x, v1c, v2c, v3c + ! + v1x=0.d0 ; v2x=0.d0 ; v3x=0.d0 ; ex=0.d0 + v1c=0.d0 ; v2c=0.d0 ; v3c=0.d0 ; ec=0.d0 + ! + DO k = 1, length + ! + arho = ABS(rho(k)) + ! + IF ( (arho<=rho_threshold).OR.(grho2(k)<=grho2_threshold).OR.(ABS(tau(k))<=rho_threshold) ) CYCLE + ! + SELECT CASE( imeta_l ) + CASE( 1 ) + CALL tpsscxc( arho, grho2(k), tau(k), ex(k), ec(k), v1x(k), v2x(k), v3x(k), v1c(k), v2c(k), v3c(k) ) + CASE( 2 ) + CALL m06lxc( arho, grho2(k), tau(k), ex(k), ec(k), v1x(k), v2x(k), v3x(k), v1c(k), v2c(k), v3c(k) ) + CASE( 4 ) + ! do nothing + CASE DEFAULT + CALL errore( 'tau_xc', 'wrong igcx and/or igcc', 1 ) + END SELECT + ! + ENDDO + ! + RETURN + ! +END SUBROUTINE tau_xc +! +! +!---------------------------------------------------------------------------------------- +SUBROUTINE tau_xc_spin( length, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c ) + !------------------------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER, INTENT(IN) :: length + REAL(DP), INTENT(IN) :: rho(length,2), tau(length,2) + REAL(DP), INTENT(IN) :: grho(3,length,2) + ! + REAL(DP), INTENT(OUT) :: ex(length), ec(length), v1x(length,2), v2x(length,2), & + v3x(length,2), v1c(length,2), v3c(length,2) + REAL(DP), INTENT(OUT) :: v2c(3,length,2) + ! + ! ... local variables + ! + INTEGER :: k, ipol + REAL(DP) :: rh, zeta, atau, grho2(2), ggrho2 + ! + ex=0.0_DP ; v1x=0.0_DP ; v2x=0.0_DP ; v3x=0.0_DP + ec=0.0_DP ; v1c=0.0_DP ; v2c=0.0_DP ; v3c=0.0_DP + ! + ! FIXME: for SCAN, this will be calculated later + ! + DO k = 1, length + ! + rh = rho(k,1) + rho(k,2) + atau = tau(k,1) + tau(k,2) ! KE-density in Hartree + grho2(1) = SUM( grho(:,k,1)**2 ) + grho2(2) = SUM( grho(:,k,2)**2 ) + ggrho2 = grho2(1) + grho2(2) + ! + IF ((rh <= rho_threshold) .OR. (ggrho2 <= grho2_threshold) .OR. (ABS(atau) <= tau_threshold)) CYCLE + ! + SELECT CASE( imeta_l ) + CASE( 1 ) + ! + CALL tpsscx_spin( rho(k,1), rho(k,2), grho2(1), grho2(2), tau(k,1), & + tau(k,2), ex(k), v1x(k,1), v1x(k,2), v2x(k,1), v2x(k,2), v3x(k,1), v3x(k,2) ) + ! + zeta = (rho(k,1) - rho(k,2)) / rh + ! + CALL tpsscc_spin( rh, zeta, grho(:,k,1), grho(:,k,2), atau, ec(k), & + v1c(k,1), v1c(k,2), v2c(:,k,1), v2c(:,k,2), v3c(k,1), v3c(k,2) ) + ! + CASE( 2 ) + ! + CALL m06lxc_spin( rho(k,1), rho(k,2), grho(:,k,1), grho(:,k,2), tau(k,1), tau(k,2), ex(k), ec(k), & + v1x(k,1), v1x(k,2), v2x(k,1), v2x(k,2), v3x(k,1), v3x(k,2), & + v1c(k,1), v1c(k,2), v2c(:,k,1), v2c(:,k,2), v3c(k,1), v3c(k,2) ) + ! + CASE DEFAULT + ! + CALL errore( 'tau_xc_spin', 'This case not implemented', imeta_l ) + ! + END SELECT + ! + ENDDO + ! + RETURN + ! +END SUBROUTINE tau_xc_spin +! +! +END MODULE xc_mgga diff --git a/PP/src/benchmark_libxc.f90 b/PP/src/benchmark_libxc.f90 index b08a9c2148..96366325ef 100644 --- a/PP/src/benchmark_libxc.f90 +++ b/PP/src/benchmark_libxc.f90 @@ -5,8 +5,17 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! -! +!----------------------------------------------------------------------------------- PROGRAM benchmark_libxc + !-------------------------------------------------------------------------------- + !! This program compares the output results (energies and potentials) from the libxc + !! routines with the ones from q-e xc internal library. + !! Available options: + !! * full LDA ; + !! * derivative of LDA pot. (dmxc) ; + !! * full GGA ; + !! * derivative of GGA pot. (dgcxc, the polarized case is not yet complete) ; + !! * full metaGGA . ! !------------------------------------------------------------------------------------! ! To be run on a single processor @@ -19,6 +28,7 @@ PROGRAM benchmark_libxc ! USE xc_lda_lsda USE xc_gga + USE xc_mgga ! IMPLICIT NONE ! @@ -26,10 +36,10 @@ PROGRAM benchmark_libxc INTEGER, PARAMETER :: DP = SELECTED_REAL_KIND(14,200) INTEGER, PARAMETER :: nnr = 6 CHARACTER(LEN=120) :: aprx, e_q, f_q - INTEGER :: ii, ns, np, quit, i_sub, family + INTEGER :: ii, ns, np, ipol, quit, i_sub, family REAL(DP) :: exx_frctn - LOGICAL :: LDA, GGA, POLARIZED, ENERGY_ONLY, DF_OK - REAL(DP), PARAMETER :: null = 0.0_DP, pi34 = 0.6203504908994_DP + LOGICAL :: LDA, GGA, MGGA, POLARIZED, ENERGY_ONLY, DF_OK + REAL(DP), PARAMETER :: null=0.0_DP, pi34=0.6203504908994_DP ! !----------QE vars -------------------------- INTEGER :: iexch_qe, icorr_qe @@ -37,11 +47,13 @@ PROGRAM benchmark_libxc REAL(DP), ALLOCATABLE :: rho_qe(:,:) REAL(DP), ALLOCATABLE :: rho_tot(:), zeta(:) REAL(DP), ALLOCATABLE :: grho(:,:,:), grho_ud(:), grho2(:,:), grh2(:) + REAL(DP), ALLOCATABLE :: tau_qe(:,:) REAL(DP), ALLOCATABLE :: ex_qe(:), ec_qe(:) REAL(DP), ALLOCATABLE :: vx_qe(:,:), vc_qe(:,:) REAL(DP), ALLOCATABLE :: dmuxc(:,:,:) - REAL(DP), ALLOCATABLE :: v1x(:,:), v2x(:,:) + REAL(DP), ALLOCATABLE :: v1x(:,:), v2x(:,:), v3x(:,:) REAL(DP), ALLOCATABLE :: v1c(:,:), v2c(:,:), v2c_ud(:) + REAL(DP), ALLOCATABLE :: v2cm(:,:,:), v3c(:,:) REAL(DP), ALLOCATABLE :: vrrx(:,:), vsrx(:,:), vssx(:,:) REAL(DP), ALLOCATABLE :: vrrc(:,:), vsrc(:,:), vssc(:), vrzc(:,:) ! @@ -52,21 +64,24 @@ PROGRAM benchmark_libxc INTEGER :: iexch_lxc, icorr_lxc INTEGER :: pol_unpol REAL(DP), ALLOCATABLE :: rho_lxc(:) + REAL(DP), ALLOCATABLE :: tau_lxc(:), lapl_rho(:) REAL(DP), ALLOCATABLE :: sigma(:) REAL(DP), ALLOCATABLE :: ex_lxc(:), ec_lxc(:) REAL(DP), ALLOCATABLE :: vx_lxc(:), vc_lxc(:) REAL(DP), ALLOCATABLE :: dex_lxc(:), dcr_lxc(:), df_lxc(:) REAL(DP), ALLOCATABLE :: vx_rho(:), vc_rho(:) - REAL(DP), ALLOCATABLE :: vx_sigma(:), vc_sigma(:) + REAL(DP), ALLOCATABLE :: vx_sigma(:), vc_sigma(:), v2c_lxc(:,:,:) REAL(DP), ALLOCATABLE :: vx_lxc2(:), vc_lxc2(:) REAL(DP), ALLOCATABLE :: ex_lxc2(:), ec_lxc2(:) REAL(DP), ALLOCATABLE :: v2rho2_x(:), v2rhosigma_x(:), v2sigma2_x(:) REAL(DP), ALLOCATABLE :: v2rho2_c(:), v2rhosigma_c(:), v2sigma2_c(:) + REAL(DP), ALLOCATABLE :: vx_tau(:), vc_tau(:), vlapl_rho(:) ! ! ! ******************************************************************************* ! *-----------------------------------------------------------------------------* ! * libxc funct. indexes: http://bigdft.org/Wiki/index.php?title=XC_codes * + ! * (or use function: 'xc_functional_get_number()' ) * ! * qe " " : see comments in Modules/funct.f90 * ! *-----------------------------------------------------------------------------* ! * * @@ -93,9 +108,6 @@ PROGRAM benchmark_libxc ! libxc: ec = ec_glyp (icorr=131) / vc = vc_glyp (131) ! ... same for polarized case ! - ! - pbe => differences of the order of 1-5% only in the polarized case by - ! adding thw pw lda part (in qe) - ! ! PRINT *, CHAR(10)//" --- BENCHMARK TEST BETWEEN QE AND LIBXC ---"//CHAR(10)//" " ! @@ -104,7 +116,7 @@ PROGRAM benchmark_libxc DF_OK = .FALSE. IF ( TRIM(f_q) == 'y' ) DF_OK = .TRUE. IF ( TRIM(f_q) /= 'y' .AND. TRIM(f_q) /= 'n' ) THEN - PRINT *, CHAR(10)//"ERROR: it is yes (y) or no (n)"//CHAR(10) + PRINT *, CHAR(10)//"Wrong answer"//CHAR(10) GO TO 10 ENDIF ! @@ -115,15 +127,15 @@ PROGRAM benchmark_libxc ENERGY_ONLY = .FALSE. IF ( TRIM(e_q) == 'y' ) ENERGY_ONLY = .TRUE. IF ( TRIM(e_q) /= 'y' .AND. TRIM(e_q) /= 'n' ) THEN - PRINT *, CHAR(10)//"ERROR: it is yes (y) or no (n)"//CHAR(10) + PRINT *, CHAR(10)//"Wrong answer"//CHAR(10) GO TO 10 ENDIF ENDIF ! - WRITE (*,'(/,1x,a)', ADVANCE='no') "lda or gga ? " + WRITE (*,'(/,1x,a)', ADVANCE='no') "lda or gga or mgga ? " READ(*,*) aprx - IF ( TRIM(aprx) /= 'lda' .AND. TRIM(aprx) /= 'gga' ) THEN - PRINT *, CHAR(10)//"ERROR: you can only choose lda or gga"//CHAR(10) + IF ( TRIM(aprx) /= 'lda' .AND. TRIM(aprx) /= 'gga' .AND. TRIM(aprx) /= 'mgga' ) THEN + PRINT *, CHAR(10)//"ERROR: you can only choose among lda, gga and mgga"//CHAR(10) GO TO 10 ENDIF WRITE (*,'(/,1x,a)', ADVANCE='no') "Polarization switch (1 unpolarized, & @@ -146,13 +158,21 @@ PROGRAM benchmark_libxc ENDIF ! ! - IF ( TRIM(aprx) == 'lda' ) THEN - LDA = .TRUE. - GGA = .FALSE. - ELSE - LDA = .FALSE. - GGA = .TRUE. - ENDIF + SELECT CASE( TRIM(aprx) ) + CASE( 'lda' ) + LDA = .TRUE. + GGA = .FALSE. + MGGA = .FALSE. + CASE( 'gga' ) + LDA = .FALSE. + GGA = .TRUE. + MGGA = .FALSE. + CASE( 'mgga' ) + LDA = .FALSE. + GGA = .FALSE. + MGGA = .TRUE. + END SELECT + ! ! POLARIZED = .FALSE. IF (ns == 2) THEN @@ -194,13 +214,20 @@ PROGRAM benchmark_libxc IF ( .NOT.POLARIZED ) ALLOCATE( dmuxc(nnr,1,1) ) IF ( POLARIZED ) ALLOCATE( dmuxc(nnr,2,2) ) ENDIF - ELSEIF ( GGA ) THEN - ALLOCATE( grho(nnr,3,ns), grho2(nnr,ns), grho_ud(nnr), grh2(nnr) ) + ELSEIF ( GGA .OR. MGGA ) THEN + ALLOCATE( grho(nnr,3,ns), grho_ud(nnr), grho2(nnr,ns) ) ALLOCATE( v1x(nnr,ns), v2x(nnr,ns) ) - ALLOCATE( v1c(nnr,ns), v2c(nnr,ns), v2c_ud(nnr) ) - IF (DF_OK) THEN - ALLOCATE( vrrx(nnr,ns), vsrx(nnr,ns), vssx(nnr,ns) ) - ALLOCATE( vrrc(nnr,ns), vsrc(nnr,ns), vssc(nnr), vrzc(nnr,ns) ) + ALLOCATE( v1c(nnr,ns) ) + IF ( GGA ) THEN + ALLOCATE( grh2(nnr) ) + ALLOCATE( v2c(nnr,ns), v2c_ud(nnr) ) + IF ( DF_OK ) THEN + ALLOCATE( vrrx(nnr,ns), vsrx(nnr,ns), vssx(nnr,ns) ) + ALLOCATE( vrrc(nnr,ns), vsrc(nnr,ns), vssc(nnr), vrzc(nnr,ns) ) + ENDIF + ELSEIF ( MGGA ) THEN + ALLOCATE( v2cm(np,nnr,ns), tau_qe(nnr,ns) ) + ALLOCATE( v3x(nnr,ns), v3c(nnr,ns) ) ENDIF ENDIF ! @@ -214,22 +241,30 @@ PROGRAM benchmark_libxc IF ( .NOT.POLARIZED ) ALLOCATE( dex_lxc(nnr), dcr_lxc(nnr), df_lxc(nnr) ) IF ( POLARIZED ) ALLOCATE( dex_lxc(nnr*3), dcr_lxc(nnr*3), df_lxc(nnr*3) ) ENDIF - ELSEIF ( GGA ) THEN + ELSEIF ( GGA .OR. MGGA ) THEN ALLOCATE( sigma(nnr*np) ) ALLOCATE( vx_rho(nnr*ns), vx_sigma(nnr*np) ) ALLOCATE( vc_rho(nnr*ns), vc_sigma(nnr*np) ) - ALLOCATE( vx_lxc2(nnr*ns), vc_lxc2(nnr*ns) ) - ALLOCATE( ex_lxc2(nnr), ec_lxc2(nnr) ) - IF ( DF_OK ) THEN - IF ( .NOT.POLARIZED ) THEN - ALLOCATE( dex_lxc(nnr), dcr_lxc(nnr), df_lxc(nnr) ) - ALLOCATE( v2rho2_x(nnr), v2rhosigma_x(nnr), v2sigma2_x(nnr) ) - ALLOCATE( v2rho2_c(nnr), v2rhosigma_c(nnr), v2sigma2_c(nnr) ) - ELSEIF ( POLARIZED ) THEN - ALLOCATE( dex_lxc(nnr*3), dcr_lxc(nnr*3), df_lxc(nnr*3) ) - ALLOCATE( v2rho2_x(3*nnr), v2rhosigma_x(6*nnr), v2sigma2_x(6*nnr) ) - ALLOCATE( v2rho2_c(3*nnr), v2rhosigma_c(6*nnr), v2sigma2_c(6*nnr) ) + ! + IF ( GGA ) THEN + ALLOCATE( vx_lxc2(nnr*ns), vc_lxc2(nnr*ns) ) + ALLOCATE( ex_lxc2(nnr), ec_lxc2(nnr) ) + IF ( DF_OK ) THEN + IF ( .NOT.POLARIZED ) THEN + ALLOCATE( dex_lxc(nnr), dcr_lxc(nnr), df_lxc(nnr) ) + ALLOCATE( v2rho2_x(nnr), v2rhosigma_x(nnr), v2sigma2_x(nnr) ) + ALLOCATE( v2rho2_c(nnr), v2rhosigma_c(nnr), v2sigma2_c(nnr) ) + ELSEIF ( POLARIZED ) THEN + ALLOCATE( dex_lxc(nnr*3), dcr_lxc(nnr*3), df_lxc(nnr*3) ) + ALLOCATE( v2rho2_x(3*nnr), v2rhosigma_x(6*nnr), v2sigma2_x(6*nnr) ) + ALLOCATE( v2rho2_c(3*nnr), v2rhosigma_c(6*nnr), v2sigma2_c(6*nnr) ) + ENDIF ENDIF + ELSEIF ( MGGA ) THEN + ALLOCATE( tau_lxc(nnr*ns), lapl_rho(nnr*ns*np) ) + ALLOCATE( vx_tau(nnr*ns), vc_tau(nnr*ns) ) + ALLOCATE( vlapl_rho(nnr*ns*np) ) + ALLOCATE( v2c_lxc(np,nnr,ns) ) ENDIF ENDIF ! @@ -243,16 +278,17 @@ PROGRAM benchmark_libxc rho_tot = 0.0_DP zeta = 0.0_DP ENDIF - IF ( GGA ) THEN + IF ( GGA .OR. MGGA ) THEN grho = 0.0_DP grho2 = 0.0_DP - grho_ud = 0.0_DP + IF (GGA) grho_ud = 0.0_DP ENDIF ! ! ... libcx ! rho_lxc = 0.0_DP - IF ( GGA ) sigma = 0.0_DP + IF ( GGA .OR. MGGA ) sigma = 0.0_DP + lapl_rho = 0.0_DP ! ! -------- Setting up an arbitrary input for both qe and libxc ----- ! @@ -262,36 +298,41 @@ PROGRAM benchmark_libxc ! rho_qe(ii,1) = DBLE(ii)/DBLE(nnr+2) ! - IF ( GGA ) THEN + IF ( GGA .OR. MGGA ) THEN grho(ii,1,1) = ABS( 0.05_DP + 0.8_DP*SIN(DBLE(ii)) ) grho(ii,2,1) = ABS( 0.05_DP + 0.7_DP*SIN(DBLE(ii)) ) grho(ii,3,1) = ABS( 0.05_DP + 0.6_DP*SIN(DBLE(ii)) ) ENDIF grho2(ii,1) = grho(ii,1,1)**2 + grho(ii,2,1)**2 + grho(ii,3,1)**2 ! + IF ( MGGA ) tau_qe(ii,1) = ABS( 0.05_DP + 0.8_DP*SIN(DBLE(ii)) )*0.5d0 + ! IF ( POLARIZED ) THEN ! rho_qe(ii,2) = (1.0_DP - rho_qe(ii,1))*0.7_DP rho_tot(ii) = rho_qe(ii,1) + rho_qe(ii,2) zeta(ii) = (rho_qe(ii,1) - rho_qe(ii,2)) / rho_tot(ii) ! - IF ( GGA ) THEN + IF ( GGA .OR. MGGA ) THEN grho(ii,1,2) = ABS( (1.0_DP - grho(ii,1,1))*0.7_DP ) grho(ii,2,2) = ABS( (1.0_DP - grho(ii,2,1))*0.6_DP ) grho(ii,3,2) = ABS( (1.0_DP - grho(ii,3,1))*0.5_DP ) ! - grh2(ii)= ( grho(ii,1,1) + grho(ii,1,2) )**2 + & - ( grho(ii,2,1) + grho(ii,2,2) )**2 + & - ( grho(ii,3,1) + grho(ii,3,2) )**2 - ! grho2(ii,2) = ( grho(ii,1,2)**2 + grho(ii,2,2)**2 + grho(ii,3,2)**2 ) ! grho_ud(ii) = grho(ii,1,1) * grho(ii,1,2) + & grho(ii,2,1) * grho(ii,2,2) + & grho(ii,3,1) * grho(ii,3,2) + IF (GGA) THEN + grh2(ii) = ( grho(ii,1,1) + grho(ii,1,2) )**2 + & + ( grho(ii,2,1) + grho(ii,2,2) )**2 + & + ( grho(ii,3,1) + grho(ii,3,2) )**2 + ENDIF ! ENDIF ! + IF ( MGGA ) tau_qe(ii,2) = ABS( 0.05_DP + 0.8_DP*SIN(DBLE(ii)) )*0.2d0 + ! ENDIF ! ENDDO @@ -304,17 +345,23 @@ PROGRAM benchmark_libxc ! rho_lxc(ii) = rho_qe(ii,1) ! - IF ( GGA ) sigma(ii) = grho2(ii,1) + IF ( GGA .OR. MGGA ) sigma(ii) = grho2(ii,1) + IF ( MGGA ) tau_lxc(ii) = tau_qe(ii,1) ! ELSE ! rho_lxc(2*ii-1) = rho_qe(ii,1) rho_lxc(2*ii) = rho_qe(ii,2) ! - IF ( GGA ) THEN - sigma(3*ii-2) = grho2(ii,1) - sigma(3*ii-1) = grho_ud(ii) - sigma(3*ii) = grho2(ii,2) + IF ( GGA .OR. MGGA ) THEN + sigma(3*ii-2) = grho2(ii,1) + sigma(3*ii-1) = grho_ud(ii) + sigma(3*ii) = grho2(ii,2) + ENDIF + ! + IF ( MGGA ) THEN + tau_lxc(2*ii-1) = tau_qe(ii,1) + tau_lxc(2*ii) = tau_qe(ii,2) ENDIF ! ENDIF @@ -411,7 +458,6 @@ PROGRAM benchmark_libxc IF (icorr_lxc /= 131 ) then ! .AND. .NOT.(icorr_lxc == 130 .AND. POLARIZED)) THEN ! remove LDA correlation for compatibility with QE i_sub=12 !(pw) - !IF (icorr_lxc == 132) i_sub=9 !(pz) CALL xc_f90_func_init( xc_func, xc_info4, i_sub, pol_unpol ) CALL xc_f90_lda_exc_vxc( xc_func, nnr, rho_lxc(1), ec_lxc2(1), vc_lxc2(1) ) ! @@ -448,8 +494,6 @@ PROGRAM benchmark_libxc CALL select_gga_functionals( iexch_qe, icorr_qe, exx_fraction=exx_frctn ) ! IF ( DF_OK ) THEN - ! - !CALL select_lda_functionals( iexch_qe, icorr_qe ) ! IF (.NOT. POLARIZED) THEN CALL dgcxc( nnr, rho_qe(:,1), grho2(:,1), vrrx(:,1), vsrx(:,1), vssx(:,1), & @@ -482,15 +526,6 @@ PROGRAM benchmark_libxc v2c(:,2) = v2c(:,1) v2c_ud(:) = v2c(:,1) ! - ! - !IF (icorr_qe == 4) THEN - ! rs(:) = pi34 / rho_tot(:)**(1.d0/3.d0) ! .... trovare le combinazioni e mettere ordine - ! CALL pw_spin( nnr, rs, zeta, ec_qe2, vc_qe2 ) - ! ec_qe(:) = ec_qe(:) + ec_qe2(:)*rho_tot(:) - ! v1c(:,1) = v1c(:,1) + vc_qe2(:,1) - ! v1c(:,2) = v1c(:,2) + vc_qe2(:,2) - !ENDIF - ! ELSE CALL gcc_spin_more( nnr, rho_qe, grho2, grho_ud, ec_qe, v1c, v2c, v2c_ud ) CALL lsd_lyp( nnr, rho_tot, zeta, ec_qe2, vc_qe2 ) @@ -504,12 +539,61 @@ PROGRAM benchmark_libxc ! ENDIF ! - !ec_qe=ec_qe*2.d0 - !v1c = v1c * 2.d0 + ELSEIF ( MGGA ) THEN + ! + !------ LIBXC ------ + ! + ! exch + CALL xc_f90_func_init( xc_func, xc_info1, iexch_lxc, pol_unpol ) + CALL xc_f90_mgga_exc_vxc( xc_func, nnr, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), & + ex_lxc(1), vx_rho(1), vx_sigma(1), vlapl_rho(1), vx_tau(1) ) + CALL xc_f90_func_end( xc_func ) + ! + IF (.NOT. POLARIZED) THEN + ex_lxc = ex_lxc * rho_qe(:,1) + ELSE + ex_lxc = ex_lxc * rho_tot + ENDIF + vx_sigma = vx_sigma * 2.0_DP + ! + ! corr + CALL xc_f90_func_init( xc_func, xc_info2, icorr_lxc, pol_unpol ) + CALL xc_f90_mgga_exc_vxc( xc_func, nnr, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), & + ec_lxc(1), vc_rho(1), vc_sigma(1), vlapl_rho(1), vc_tau(1) ) + CALL xc_f90_func_end( xc_func ) + ! + IF (.NOT. POLARIZED) THEN + ec_lxc = ec_lxc * rho_qe(:,1) + ELSE + ec_lxc = ec_lxc * rho_tot + ENDIF + ! + IF (.NOT. POLARIZED) THEN + vc_sigma = vc_sigma * 2.0_DP + ELSE + DO ii = 1, nnr + DO ipol = 1, 3 + v2c_lxc(ipol,ii,1) = vc_sigma(3*ii-2)*grho(ii,ipol,1) * 2.D0 + vc_sigma(3*ii-1)*grho(ii,ipol,2) + v2c_lxc(ipol,ii,2) = vc_sigma(3*ii) *grho(ii,ipol,2) * 2.D0 + vc_sigma(3*ii-1)*grho(ii,ipol,1) + ENDDO + ENDDO + ENDIF + ! + !----- QE ---------- + ! + CALL select_mgga_functionals( iexch_qe, icorr_qe ) ! ... icorr_qe not used + ! + IF ( .NOT. POLARIZED ) THEN + CALL tau_xc( nnr, rho_qe(:,1), grho2(:,1), tau_qe(:,1), ex_qe, ec_qe, v1x(:,1), & + v2x(:,1), v3x(:,1), v1c(:,1), v2cm(1,:,1), v3c(:,1) ) + ELSE + CALL tau_xc_spin( nnr, rho_qe, grho2, tau_qe, ex_qe, ec_qe, v1x, v2x, v3x, v1c, & + v2cm, v3c ) + ENDIF ! - ENDIF + ENDIF ! - !------------------ + !-- ! CALL xc_f90_info_name( xc_info1, name1 ) CALL xc_f90_info_name( xc_info2, name2 ) @@ -520,6 +604,7 @@ PROGRAM benchmark_libxc PRINT *, "Correlation: ", TRIM(name2) PRINT *, " " ! + ! IF ( LDA ) THEN ! DO ii = 1, nnr, nnr-1 @@ -574,14 +659,14 @@ PROGRAM benchmark_libxc IF ( .NOT. POLARIZED ) THEN WRITE (*,101) dmuxc(ii,1,1) WRITE (*,201) df_lxc(ii) - PRINT *, " --- " - WRITE (*,301) dmuxc(ii,1,1)-df_lxc(ii) - ELSE - WRITE (*,104) dmuxc(ii,1,1), dmuxc(ii,2,1), dmuxc(ii,2,2), dmuxc(ii,1,2) - WRITE (*,203) df_lxc(3*ii-2), df_lxc(3*ii-1), df_lxc(3*ii) - PRINT *, " --- " - WRITE (*,303) dmuxc(ii,1,1)-df_lxc(3*ii-2), dmuxc(ii,2,1)-df_lxc(3*ii-1), & - dmuxc(ii,2,2)-df_lxc(3*ii) + PRINT *, " --- " + WRITE (*,301) dmuxc(ii,1,1)-df_lxc(ii) + ELSE + WRITE (*,104) dmuxc(ii,1,1), dmuxc(ii,2,1), dmuxc(ii,2,2), dmuxc(ii,1,2) + WRITE (*,203) df_lxc(3*ii-2), df_lxc(3*ii-1), df_lxc(3*ii) + PRINT *, " --- " + WRITE (*,303) dmuxc(ii,1,1)-df_lxc(3*ii-2), dmuxc(ii,2,1)-df_lxc(3*ii-1), & + dmuxc(ii,2,2)-df_lxc(3*ii) ENDIF ENDIF ! @@ -623,7 +708,7 @@ PROGRAM benchmark_libxc WRITE (*,202) vx_rho(2*ii-1), vx_rho(2*ii) PRINT *, " --- " WRITE (*,302) v1x(ii,1)-vx_rho(2*ii-1), v1x(ii,2)-vx_rho(2*ii) - ENDIF + ENDIF ! PRINT *, " " PRINT *, "=== Exchange potential vsigma ===" @@ -738,6 +823,121 @@ PROGRAM benchmark_libxc ! ENDDO ! + ELSEIF ( MGGA ) THEN + ! + DO ii = 1, nnr !, nnr-1 + WRITE(*,*) ' ' + WRITE(*,*) ' ' + WRITE(*,909) ii, nnr + IF (.NOT. POLARIZED ) THEN + WRITE (*,401) rho_qe(ii,1) + WRITE (*,501) grho2(ii,1) + WRITE (*,601) tau_qe(ii,1) + ELSE + WRITE (*,402) rho_qe(ii,1), rho_qe(ii,2) + WRITE (*,502) grho2(ii,1), grho2(ii,2) + WRITE (*,602) tau_qe(ii,1), tau_qe(ii,2) + ENDIF + ! + PRINT *, " " + PRINT *, "=== Exchange and correlation energies: ===" + WRITE (*,102) ex_qe(ii), ec_qe(ii) + WRITE (*,202) ex_lxc(ii), ec_lxc(ii) + PRINT *, " --- " + WRITE (*,302) ex_qe(ii)-ex_lxc(ii), ec_qe(ii)-ec_lxc(ii) + !WRITE (*,302) ex_qe(ii)/ex_lxc(ii), ec_qe(ii)/ec_lxc(ii) + ! + IF (.NOT. ENERGY_ONLY) THEN + ! + PRINT *, " " + PRINT *, "=== Exchange potential vrho ===" + IF ( .NOT. POLARIZED ) THEN + WRITE (*,101) v1x(ii,1) + WRITE (*,201) vx_rho(ii) + PRINT *, " --- " + WRITE (*,301) v1x(ii,1)-vx_rho(ii) + ELSEIF ( POLARIZED ) THEN + WRITE (*,102) v1x(ii,1), v1x(ii,2) + WRITE (*,202) vx_rho(2*ii-1), vx_rho(2*ii) + PRINT *, " --- " + WRITE (*,302) v1x(ii,1)-vx_rho(2*ii-1), v1x(ii,2)-vx_rho(2*ii) + ENDIF + ! + PRINT *, " " + PRINT *, "=== Exchange potential vsigma ===" + IF ( .NOT. POLARIZED ) THEN + WRITE (*,101) v2x(ii,1) + WRITE (*,201) vx_sigma(ii) + PRINT *, " --- " + WRITE (*,301) v2x(ii,1)-vx_sigma(ii) + ELSEIF ( POLARIZED ) THEN + WRITE (*,103) v2x(ii,1), null, v2x(ii,2) + WRITE (*,203) vx_sigma(3*ii-2), vx_sigma(3*ii-1), vx_sigma(3*ii) + PRINT *, " --- " + WRITE (*,303) v2x(ii,1)-vx_sigma(3*ii-2), null-vx_sigma(3*ii-1), & + v2x(ii,2)-vx_sigma(3*ii) + ENDIF + ! + PRINT *, " " + PRINT *, "=== Exchange potential vtau ===" + IF ( .NOT. POLARIZED ) THEN + WRITE (*,101) v3x(ii,1) + WRITE (*,201) vx_tau(ii) + PRINT *, " --- " + WRITE (*,301) v3x(ii,1)-vx_tau(ii) + ELSEIF ( POLARIZED ) THEN + WRITE (*,102) v3x(ii,1), v3x(ii,2) + WRITE (*,202) vx_tau(2*ii-1), vx_tau(2*ii) + PRINT *, " --- " + WRITE (*,303) v3x(ii,1)-vx_tau(2*ii-1), v3x(ii,2)-vx_tau(2*ii) + ENDIF + ! + PRINT *, " " + PRINT *, "=== Correlation potential vrho ===" + IF ( .NOT. POLARIZED ) THEN + WRITE (*,101) v1c(ii,1) + WRITE (*,201) vc_rho(ii) + PRINT *, " --- " + WRITE (*,301) v1c(ii,1)-vc_rho(ii) + ELSEIF ( POLARIZED ) THEN + WRITE (*,102) v1c(ii,1), v1c(ii,2) + WRITE (*,202) vc_rho(2*ii-1), vc_rho(2*ii) + PRINT *, " --- " + WRITE (*,302) v1c(ii,1)-vc_rho(2*ii-1), v1c(ii,2)-vc_rho(2*ii) + ENDIF + ! + PRINT *, " " + PRINT *, "=== Correlation potential vsigma ===" + IF ( .NOT. POLARIZED ) THEN + WRITE (*,101) v2cm(1,ii,1) + WRITE (*,201) vc_sigma(ii) + PRINT *, " --- " + WRITE (*,301) v2cm(1,ii,1)-vc_sigma(ii) + ELSEIF ( POLARIZED ) THEN + WRITE (*,102) v2cm(1,ii,1), v2cm(1,ii,2) + WRITE (*,203) v2c_lxc(1,ii,1), v2c_lxc(1,ii,2) + PRINT *, " --- " + WRITE (*,303) v2cm(1,ii,1)-v2c_lxc(1,ii,1), v2cm(1,ii,2)-v2c_lxc(1,ii,2) + ENDIF + ! + PRINT *, " " + PRINT *, "=== Correlation potential vtau ===" + IF ( .NOT. POLARIZED ) THEN + WRITE (*,101) v3c(ii,1) + WRITE (*,201) vc_tau(ii) + PRINT *, " --- " + WRITE (*,301) v3c(ii,1)-vc_tau(ii) + ELSEIF ( POLARIZED ) THEN + WRITE (*,102) v3c(ii,1), v3c(ii,2) + WRITE (*,202) vc_tau(2*ii-1), vc_tau(2*ii) + PRINT *, " --- " + WRITE (*,302) v3c(ii,1)-vc_tau(2*ii-1), v3c(ii,2)-vc_tau(2*ii) + ENDIF + ! + ENDIF + ! + ENDDO + ! ENDIF ! 101 FORMAT('qe: ',3x,F17.14) @@ -757,10 +957,15 @@ PROGRAM benchmark_libxc 402 FORMAT('rho(up,down): ',F17.14,4x,F17.14) ! 501 FORMAT('grho2: ',F17.14) + 502 FORMAT('grho2(uu,dd): ',F17.14,4x,F17.14) 503 FORMAT('grho2(uu,ud,dd): ',F17.14,4x,F17.14,4x,F17.14) ! + 601 FORMAT('tau: ',F17.14) + 602 FORMAT('tau(up,down): ',F17.14,4x,F17.14) + ! 909 FORMAT('grid-point: ',I4,' of',I4) ! + ! -- qe DEALLOCATE( rho_qe ) IF ( POLARIZED ) DEALLOCATE( rho_tot, zeta ) DEALLOCATE( ex_qe, ec_qe ) @@ -769,16 +974,23 @@ PROGRAM benchmark_libxc IF ( DF_OK ) THEN DEALLOCATE( dmuxc ) ENDIF - ELSEIF ( GGA ) THEN - DEALLOCATE( grho, grho2, grho_ud, grh2 ) - DEALLOCATE( v1x, v2x ) - DEALLOCATE( v1c, v2c, v2c_ud ) - IF (DF_OK) THEN - DEALLOCATE( vrrx, vsrx, vssx ) - DEALLOCATE( vrrc, vsrc, vssc, vrzc ) + ELSEIF ( GGA .OR. MGGA ) THEN + DEALLOCATE( grho, grho_ud, grho2 ) + DEALLOCATE( v1x, v2x, v1c ) + IF ( GGA ) THEN + DEALLOCATE( grh2 ) + DEALLOCATE( v2c, v2c_ud ) + IF (DF_OK) THEN + DEALLOCATE( vrrx, vsrx, vssx ) + DEALLOCATE( vrrc, vsrc, vssc, vrzc ) + ENDIF + ELSEIF ( MGGA ) THEN + DEALLOCATE( tau_qe ) + DEALLOCATE( v2cm, v3x, v3c ) ENDIF ENDIF ! + ! -- libxc DEALLOCATE( rho_lxc ) DEALLOCATE( ex_lxc, ec_lxc ) IF ( LDA ) THEN @@ -796,6 +1008,12 @@ PROGRAM benchmark_libxc DEALLOCATE( v2rho2_x, v2rhosigma_x, v2sigma2_x ) DEALLOCATE( v2rho2_c, v2rhosigma_c, v2sigma2_c ) ENDIF + ELSEIF ( MGGA ) THEN + DEALLOCATE( sigma, tau_lxc, lapl_rho ) + DEALLOCATE( vx_rho, vx_sigma, vx_tau ) + DEALLOCATE( vc_rho, vc_sigma, vc_tau ) + DEALLOCATE( vlapl_rho ) + DEALLOCATE( v2c_lxc ) ENDIF ! PRINT *, " " diff --git a/PP/src/make.depend b/PP/src/make.depend index e94034d3db..fe74cbbf86 100644 --- a/PP/src/make.depend +++ b/PP/src/make.depend @@ -91,6 +91,7 @@ bands.o : ../../UtilXlib/mp.o benchmark_libxc.o : ../../Modules/libxc.o benchmark_libxc.o : ../../Modules/xc_gga_drivers.o benchmark_libxc.o : ../../Modules/xc_lda_lsda_drivers.o +benchmark_libxc.o : ../../Modules/xc_mgga_drivers.o chdens_bspline.o : ../../Modules/bspline.o chdens_bspline.o : ../../Modules/cell_base.o chdens_bspline.o : ../../Modules/fft_base.o diff --git a/PW/src/make.depend b/PW/src/make.depend index ccd73aca42..2c534d7342 100644 --- a/PW/src/make.depend +++ b/PW/src/make.depend @@ -1880,6 +1880,7 @@ stres_gradcorr.o : ../../Modules/funct.o stres_gradcorr.o : ../../Modules/kind.o stres_gradcorr.o : ../../Modules/mp_bands.o stres_gradcorr.o : ../../Modules/xc_gga_drivers.o +stres_gradcorr.o : ../../Modules/xc_mgga_drivers.o stres_gradcorr.o : ../../UtilXlib/mp.o stres_har.o : ../../FFTXlib/fft_interfaces.o stres_har.o : ../../Modules/cell_base.o @@ -2167,6 +2168,7 @@ v_of_rho.o : ../../Modules/noncol.o v_of_rho.o : ../../Modules/recvec.o v_of_rho.o : ../../Modules/tsvdw.o v_of_rho.o : ../../Modules/xc_lda_lsda_drivers.o +v_of_rho.o : ../../Modules/xc_mgga_drivers.o v_of_rho.o : ../../UtilXlib/mp.o v_of_rho.o : Coul_cut_2D.o v_of_rho.o : esm.o diff --git a/PW/src/stres_gradcorr.f90 b/PW/src/stres_gradcorr.f90 index 83d052b59b..3bc4b94f04 100644 --- a/PW/src/stres_gradcorr.f90 +++ b/PW/src/stres_gradcorr.f90 @@ -12,9 +12,10 @@ SUBROUTINE stres_gradcorr( rho, rhog, rho_core, rhog_core, kedtau, nspin, & !---------------------------------------------------------------------------- ! USE kinds, ONLY: DP - USE funct, ONLY: dft_is_gradient, dft_is_meta, get_igcc, & - tau_xc, tau_xc_spin, get_meta - USE xc_gga, ONLY: xc_gcx !gcxc, gcx_spin, gcc_spin, gcc_spin_more + USE funct, ONLY: dft_is_gradient, dft_is_meta, get_igcc, & + get_meta + USE xc_gga, ONLY: xc_gcx + USE xc_mgga, ONLY: xc_metagcx USE mp_bands, ONLY: intra_bgrp_comm USE mp, ONLY: mp_sum USE fft_types, ONLY: fft_type_descriptor @@ -32,30 +33,29 @@ SUBROUTINE stres_gradcorr( rho, rhog, rho_core, rhog_core, kedtau, nspin, & ! ! ... local variables ! - INTEGER :: k, l, m, ipol, is, nspin0 + INTEGER :: k, l, m, ipol, is, nspin0, np INTEGER :: nr1, nr2, nr3, nrxx, ngm REAL(DP), ALLOCATABLE :: grho(:,:,:), rhoaux(:,:) REAL(DP), ALLOCATABLE :: grho2(:,:), grho_ud(:),grhor2(:) COMPLEX(DP), ALLOCATABLE :: rhogaux(:,:) - !^^^ + ! REAL(DP), ALLOCATABLE :: zeta(:), rh(:) REAL(DP) :: sx(dfft%nnr), sc(dfft%nnr) - REAL(DP), ALLOCATABLE :: v1x(:,:), v2x(:,:), rhos(:) - REAL(DP), ALLOCATABLE :: v1c(:,:), v2c(:,:), v2c_ud(:) - INTEGER, ALLOCATABLE :: null_v(:) - REAL(DP) :: vnull + REAL(DP), ALLOCATABLE :: v1x(:,:), v2x(:,:), v3x(:,:), rhos(:) + REAL(DP), ALLOCATABLE :: v1c(:,:), v2c(:,:,:), v3c(:,:), v2c_ud(:) ! REAL(DP), PARAMETER :: epsr = 1.0d-6, epsg = 1.0d-10, e2 = 2.d0 REAL(DP) :: sigma_gradcorr(3, 3) LOGICAL :: igcc_is_lyp ! - ! ... dummy variables for meta-gga - REAL(DP) :: v3x, v3c, v3xup, v3xdw, v3cup, v3cdw - ! ! IF ( .NOT. dft_is_gradient() .AND. .NOT. dft_is_meta() ) RETURN ! nspin0 = nspin + ! + np = 1 + IF (nspin0==2 .AND. dft_is_meta()) np=3 + ! !if (nspin==4) nspin0 = 1 !if (nspin==4.and.domag) nspin0 = 2 IF ( nspin==4 ) CALL errore('stres_gradcorr', & @@ -77,8 +77,9 @@ SUBROUTINE stres_gradcorr( rho, rhog, rho_core, rhog_core, kedtau, nspin, & ALLOCATE( grho2(nrxx,nspin0) ) ALLOCATE( rhogaux(ngm,nspin0) ) ! - ALLOCATE( v1x(nrxx,nspin0), v2x(nrxx,nspin0) ) - ALLOCATE( v1c(nrxx,nspin0), v2c(nrxx,nspin0) ) + ALLOCATE( v1x(nrxx,nspin0), v2x(nrxx,nspin0), v3x(nrxx,nspin0) ) + ALLOCATE( v1c(nrxx,nspin0), v2c(np,nrxx,nspin0), v3c(nrxx,nspin0) ) + ! ! calculate the gradient of rho+rhocore in real space ! in LSDA case rho is temporarily converted in (up,down) format @@ -112,41 +113,49 @@ SUBROUTINE stres_gradcorr( rho, rhog, rho_core, rhog_core, kedtau, nspin, & ! sigma_gradcor_{alpha,beta} == ! omega^-1 \int (grad_alpha rho) ( D(rho*Exc)/D(grad_alpha rho) ) d3 ! - ALLOCATE( null_v(nrxx) ) - ! ! routine computing v1x_v and v2x_v is different for GGA and meta-GGA ! FIXME : inefficient implementation ! - null_v = 1 grho2(:,1) = grho(1,:,1)**2 + grho(2,:,1)**2 + grho(3,:,1)**2 ! - WHERE( .NOT. (ABS(rhoaux(:,1))>epsr .AND. grho2(:,1)>epsg) ) null_v(:) = 0 - ! IF ( .NOT. (dft_is_meta() .AND. get_meta() /= 4) ) & - CALL xc_gcx( nrxx, nspin, rhoaux, grho, sx, sc, v1x, v2x, v1c, v2c ) + CALL xc_gcx( nrxx, nspin, rhoaux, grho, sx, sc, v1x, v2x, v1c, v2c(1,:,:) ) ! - DO k = 1, nrxx - IF ( dft_is_meta() .AND. get_meta() /= 4 .AND. null_v(k) /= 0 ) THEN - IF ( ABS(rhoaux(k,1))>epsr .AND. grho2(k,1)>epsg ) THEN - ! - kedtau(k,1) = kedtau(k,1) / e2 - CALL tau_xc( rhoaux(k,1), grho2(k,1), kedtau(k,1), sx(k), sc(k), & - v1x(k,1), v2x(k,1), v3x, v1c(k,1), v2c(k,1), v3c ) - kedtau(k,1) = kedtau(k,1) * e2 - ! - ENDIF - ENDIF - ! - DO l = 1, 3 - DO m = 1, l - sigma_gradcorr(l,m) = sigma_gradcorr(l,m) + grho(l,k,1)*grho(m,k,1)* & - e2 * (v2x(k,1) + v2c(k,1)) !* null_v(k) - ENDDO - ENDDO - ! + IF ( dft_is_meta() .AND. get_meta() /= 4 ) THEN + kedtau(:,1) = kedtau(:,1) / e2 + CALL xc_metagcx( nrxx, 1, np, rhoaux, grho, kedtau, sx, sc, & + v1x, v2x, v3x, v1c, v2c, v3c ) + kedtau(:,1) = kedtau(:,1) * e2 + ENDIF + ! + DO l = 1, 3 + DO m = 1, l + sigma_gradcorr(l,m) = sigma_gradcorr(l,m) + SUM( grho(l,:,1)*grho(m,:,1)* & + e2 * (v2x(:,1) + v2c(1,:,1)) ) + ENDDO ENDDO ! - DEALLOCATE( null_v ) + ! +! DO k = 1, nrxx +! IF ( dft_is_meta() .AND. get_meta() /= 4 .AND. null_v(k) /= 0 ) THEN +! IF ( ABS(rhoaux(k,1))>epsr .AND. grho2(k,1)>epsg ) THEN +! ! +! kedtau(k,1) = kedtau(k,1) / e2 +! CALL tau_xc( rhoaux(k,1), grho2(k,1), kedtau(k,1), sx(k), sc(k), & +! v1x(k,1), v2x(k,1), v3x, v1c(k,1), v2c(k,1), v3c ) +! kedtau(k,1) = kedtau(k,1) * e2 +! ! +! ENDIF +! ENDIF +! ! +! DO l = 1, 3 +! DO m = 1, l +! sigma_gradcorr(l,m) = sigma_gradcorr(l,m) + grho(l,k,1)*grho(m,k,1)* & +! e2 * (v2x(k,1) + v2c(k,1)) +! ENDDO +! ENDDO +! ! +! ENDDO ! ! ELSEIF (nspin == 2) THEN @@ -167,7 +176,7 @@ SUBROUTINE stres_gradcorr( rho, rhog, rho_core, rhog_core, kedtau, nspin, & ! ALLOCATE( v2c_ud(dfft%nnr) ) ! - CALL xc_gcx( nrxx, nspin, rhoaux, grho, sx, sc, v1x, v2x, v1c, v2c, v2c_ud ) + CALL xc_gcx( nrxx, nspin, rhoaux, grho, sx, sc, v1x, v2x, v1c, v2c(1,:,:), v2c_ud ) ! DO l = 1, 3 DO m = 1, l @@ -179,8 +188,8 @@ SUBROUTINE stres_gradcorr( rho, rhog, rho_core, rhog_core, kedtau, nspin, & ! ! ... correlation sigma_gradcorr(l,m) = sigma_gradcorr(l,m) + & - SUM( grho(l,:,1) * grho(m,:,1) * v2c(:,1) + & - grho(l,:,2) * grho(m,:,2) * v2c(:,2) + & + SUM( grho(l,:,1) * grho(m,:,1) * v2c(1,:,1) + & + grho(l,:,2) * grho(m,:,2) * v2c(1,:,2) + & (grho(l,:,1) * grho(m,:,2) + & grho(l,:,2) * grho(m,:,1)) * v2c_ud(:) ) * e2 ENDDO @@ -196,8 +205,8 @@ SUBROUTINE stres_gradcorr( rho, rhog, rho_core, rhog_core, kedtau, nspin, & DEALLOCATE( grho ) DEALLOCATE( grho2 ) ! - DEALLOCATE( v1x, v2x ) - DEALLOCATE( v1c, v2c ) + DEALLOCATE( v1x, v2x, v3x ) + DEALLOCATE( v1c, v2c, v3c ) ! ! DO l = 1, 3 diff --git a/PW/src/v_of_rho.f90 b/PW/src/v_of_rho.f90 index 9e9f88318a..026f5f6f45 100644 --- a/PW/src/v_of_rho.f90 +++ b/PW/src/v_of_rho.f90 @@ -104,6 +104,8 @@ SUBROUTINE v_of_rho( rho, rho_core, rhog_core, & RETURN ! END SUBROUTINE v_of_rho +! +! !---------------------------------------------------------------------------- SUBROUTINE v_xc_meta( rho, rho_core, rhog_core, etxc, vtxc, v, kedtaur ) !---------------------------------------------------------------------------- @@ -116,14 +118,15 @@ SUBROUTINE v_xc_meta( rho, rho_core, rhog_core, etxc, vtxc, v, kedtaur ) USE gvect, ONLY : g, ngm USE lsda_mod, ONLY : nspin USE cell_base, ONLY : omega - USE funct, ONLY : tau_xc, tau_xc_spin, get_meta, dft_is_nonlocc, nlc - USE scf, ONLY : scf_type + USE funct, ONLY : get_meta, dft_is_nonlocc, nlc + USE xc_mgga, ONLY : xc_metagcx + USE scf, ONLY : scf_type, rhoz_or_updw USE mp, ONLY : mp_sum USE mp_bands, ONLY : intra_bgrp_comm ! IMPLICIT NONE ! - TYPE (scf_type), INTENT(IN) :: rho + TYPE (scf_type), INTENT(INOUT) :: rho !! the valence charge REAL(DP), INTENT(IN) :: rho_core(dfftp%nnr) !! the core charge in real space @@ -141,151 +144,121 @@ SUBROUTINE v_xc_meta( rho, rho_core, rhog_core, etxc, vtxc, v, kedtaur ) ! ... local variables ! REAL(DP) :: zeta, rh, sgn(2) - INTEGER :: k, ipol, is - REAL(DP) :: ex, ec, v1x, v2x, v3x,v1c, v2c, v3c, & - & v1xup, v1xdw, v2xup, v2xdw, v1cup, v1cdw, & - & v3xup, v3xdw,v3cup, v3cdw, & - & arho, atau, fac, rhoup, rhodw, ggrho2, tauup,taudw - - REAL(DP), DIMENSION(2) :: grho2, rhoneg - REAL(DP), DIMENSION(3) :: grhoup, grhodw, v2cup, v2cdw + INTEGER :: k, ipol, is, np ! - REAL(DP), ALLOCATABLE :: grho(:,:,:), h(:,:,:), dh(:) - REAL(DP), ALLOCATABLE :: rhoout(:) - COMPLEX(DP), ALLOCATABLE :: rhogsum(:) - REAL(DP), PARAMETER :: eps12 = 1.0d-12, zero=0._dp + REAL(DP), ALLOCATABLE :: ex(:), ec(:) + REAL(DP), ALLOCATABLE :: v1x(:,:), v2x(:,:), v3x(:,:) + REAL(DP), ALLOCATABLE :: v1c(:,:), v2c(:,:,:), v3c(:,:) ! - !---------------------------------------------------------------------------- + REAL(DP) :: fac + + REAL(DP), DIMENSION(2) :: grho2, rhoneg + REAL(DP), DIMENSION(3) :: grhoup, grhodw ! + REAL(DP), ALLOCATABLE :: grho(:,:,:), h(:,:,:), dh(:) + REAL(DP), ALLOCATABLE :: rhoout(:) + COMPLEX(DP), ALLOCATABLE :: rhogsum(:) + REAL(DP), PARAMETER :: eps12 = 1.0d-12, zero=0._dp ! CALL start_clock( 'v_xc_meta' ) ! - ! - etxc = zero - vtxc = zero - v(:,:) = zero + etxc = zero + vtxc = zero + v(:,:) = zero rhoneg(:) = zero sgn(1) = 1._dp ; sgn(2) = -1._dp - fac = 1.D0 / DBLE( nspin ) + fac = 1.D0 / DBLE( nspin ) + np = 1 + IF (nspin==2) np=3 ! - ALLOCATE (grho(3,dfftp%nnr,nspin)) - ALLOCATE (h(3,dfftp%nnr,nspin)) - ALLOCATE (rhogsum(ngm)) + ALLOCATE( grho(3,dfftp%nnr,nspin) ) + ALLOCATE( h(3,dfftp%nnr,nspin) ) + ALLOCATE( rhogsum(ngm) ) + ! + ALLOCATE( ex(dfftp%nnr), ec(dfftp%nnr) ) + ALLOCATE( v1x(dfftp%nnr,nspin), v2x(dfftp%nnr,nspin) , v3x(dfftp%nnr,nspin) ) + ALLOCATE( v1c(dfftp%nnr,nspin), v2c(np,dfftp%nnr,nspin), v3c(dfftp%nnr,nspin) ) ! ! ... calculate the gradient of rho + rho_core in real space ! ... in LSDA case rhogsum is in (up,down) format ! DO is = 1, nspin ! - rhogsum(:)=fac*rhog_core(:) + ( rho%of_g(:,1) + sgn(is)*rho%of_g(:,nspin) )*0.5D0 + rhogsum(:) = fac*rhog_core(:) + ( rho%of_g(:,1) + sgn(is)*rho%of_g(:,nspin) )*0.5D0 ! CALL fft_gradient_g2r( dfftp, rhogsum, g, grho(1,1,is) ) ! - END DO + ENDDO DEALLOCATE(rhogsum) ! - DO k = 1, dfftp%nnr - ! - DO is = 1, nspin - grho2 (is) = grho(1,k, is)**2 + grho(2,k,is)**2 + grho(3,k, is)**2 - ENDDO - ! - IF (nspin == 1) THEN - ! - ! This is the spin-unpolarised case - ! - arho = ABS(rho%of_r(k, 1) ) - ! - atau = rho%kin_r(k,1) / e2 ! kinetic energy density in Hartree - ! - IF ( (arho>eps8).AND.(grho2(1)>eps12).AND.(ABS(atau)>eps8) ) THEN - ! - CALL tau_xc( arho, grho2(1),atau, ex, ec, v1x, v2x, & - v3x,v1c, v2c,v3c ) - ! - v(k, 1) = (v1x + v1c) * e2 - ! - ! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| - h(:,k,1) = (v2x + v2c) * grho(:,k,1) * e2 - ! - kedtaur(k,1) = (v3x + v3c) * 0.5d0 * e2 - ! - etxc = etxc + (ex + ec) * e2 !* segno - vtxc = vtxc + (v1x+v1c) * e2 * arho - ! - ELSE - h (:, k, 1) = zero - kedtaur(k,1)= zero - ENDIF - ! - IF ( rho%of_r(k, 1) < zero ) rhoneg(1) = rhoneg(1) - rho%of_r (k, 1) - ! - ELSE - ! - ! spin-polarised case - ! - rhoup = ( rho%of_r(k, 1) + rho%of_r(k, 2) )*0.5d0 - rhodw = ( rho%of_r(k, 1) - rho%of_r(k, 2) )*0.5d0 - ! - rh = rhoup + rhodw - ! - do ipol=1,3 - grhoup(ipol)=grho(ipol,k,1) - grhodw(ipol)=grho(ipol,k,2) - end do - ! - ggrho2 = ( grho2 (1) + grho2 (2) ) * 4._dp - ! - tauup = rho%kin_r(k,1) / e2 - taudw = rho%kin_r(k,2) / e2 - atau = tauup + taudw - ! - IF ( (rh > eps8).AND.(ggrho2 > eps12).AND.(ABS(atau) > eps8) ) THEN - - CALL tau_xc_spin( rhoup, rhodw, grhoup, grhodw, tauup, taudw, ex, ec, & - v1xup, v1xdw, v2xup, v2xdw, v3xup, v3xdw, v1cup, & - v1cdw, v2cup, v2cdw, v3cup, v3cdw ) - ! - ! first term of the gradient correction : D(rho*Exc)/D(rho) - ! - v(k, 1) = (v1xup + v1cup) * e2 - v(k, 2) = (v1xdw + v1cdw) * e2 - ! - ! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| - ! - IF (get_meta()==1 .OR. get_meta()==5 ) THEN ! tpss, scan - ! - h(:,k,1) = (v2xup * grhoup(:) + v2cup(:)) * e2 - h(:,k,2) = (v2xdw * grhodw(:) + v2cdw(:)) * e2 - ! - ELSE - ! - h(:,k,1) = (v2xup + v2cup(1)) * grhoup(:) * e2 - h(:,k,2) = (v2xdw + v2cdw(1)) * grhodw(:) * e2 - ! - ENDIF - ! - kedtaur(k,1)= (v3xup + v3cup) * 0.5d0 * e2 - kedtaur(k,2)= (v3xdw + v3cdw) * 0.5d0 * e2 - ! - etxc = etxc + (ex + ec) * e2 - vtxc = vtxc + (v1xup+v1cup+v1xdw+v1cdw) * e2 * rh + ! + IF (nspin == 1) THEN + ! + CALL xc_metagcx( dfftp%nnr, 1, np, rho%of_r, grho, rho%kin_r/e2, ex, ec, & + v1x, v2x, v3x, v1c, v2c, v3c ) + ! + DO k = 1, dfftp%nnr + ! + v(k,1) = (v1x(k,1)+v1c(k,1)) * e2 + ! + ! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| + h(:,k,1) = (v2x(k,1)+v2c(1,k,1)) * grho(:,k,1) * e2 + ! + kedtaur(k,1) = (v3x(k,1)+v3c(k,1)) * 0.5d0 * e2 + ! + etxc = etxc + (ex(k)+ec(k)) * e2 + vtxc = vtxc + (v1x(k,1)+v1c(k,1)) * e2 * ABS(rho%of_r(k,1)) + ! + IF (rho%of_r(k,1) < zero) rhoneg(1) = rhoneg(1)-rho%of_r(k,1) + ! + ENDDO + ! + ELSE + ! + CALL rhoz_or_updw( rho, 'only_r', '->updw' ) + ! + CALL xc_metagcx( dfftp%nnr, 2, np, rho%of_r, grho, rho%kin_r/e2, ex, ec, & + v1x, v2x, v3x, v1c, v2c, v3c ) + ! + ! first term of the gradient correction : D(rho*Exc)/D(rho) + ! + DO k = 1, dfftp%nnr + ! + v(k,1) = (v1x(k,1) + v1c(k,1)) * e2 + v(k,2) = (v1x(k,2) + v1c(k,2)) * e2 + ! + ! h contains D(rho*Exc)/D(|grad rho|) * (grad rho) / |grad rho| + ! + IF ( get_meta()==1 .OR. get_meta()==5 ) THEN ! tpss, scan ! - ELSE + h(:,k,1) = (v2x(k,1) * grho(:,k,1) + v2c(:,k,1)) * e2 + h(:,k,2) = (v2x(k,2) * grho(:,k,2) + v2c(:,k,2)) * e2 ! - h(:,k,1) = zero - h(:,k,2) = zero + ELSE ! - kedtaur(k,1) = zero - kedtaur(k,2) = zero + h(:,k,1) = (v2x(k,1) + v2c(1,k,1)) * grho(:,k,1) * e2 + h(:,k,2) = (v2x(k,2) + v2c(1,k,2)) * grho(:,k,2) * e2 ! - ENDIF - ! - IF ( rhoup < zero ) rhoneg(1) = rhoneg(1) - rhoup - IF ( rhodw < zero ) rhoneg(2) = rhoneg(2) - rhodw - ! - ENDIF - ENDDO + ENDIF + ! + kedtaur(k,1) = (v3x(k,1) + v3c(k,1)) * 0.5d0 * e2 + kedtaur(k,2) = (v3x(k,2) + v3c(k,2)) * 0.5d0 * e2 + ! + etxc = etxc + (ex(k)+ec(k)) * e2 + vtxc = vtxc + (v1x(k,1)+v1c(k,1)+v1x(k,2)+v1c(k,2)) * e2 * (rho%of_r(k,1)+rho%of_r(k,2)) + ! + IF ( rho%of_r(k,1) < 0.d0 ) rhoneg(1) = rhoneg(1) - rho%of_r(k,1) + IF ( rho%of_r(k,2) < 0.d0 ) rhoneg(2) = rhoneg(2) - rho%of_r(k,2) + ! + ENDDO + ! + CALL rhoz_or_updw( rho, 'only_r', '->rhoz' ) + ! + ENDIF + ! + DEALLOCATE( ex, ec ) + DEALLOCATE( v1x, v2x, v3x ) + DEALLOCATE( v1c, v2c, v3c ) ! ! ALLOCATE( dh( dfftp%nnr ) ) @@ -334,6 +307,7 @@ SUBROUTINE v_xc_meta( rho, rho_core, rhog_core, etxc, vtxc, v, kedtaur ) ! END SUBROUTINE v_xc_meta ! +! SUBROUTINE v_xc( rho, rho_core, rhog_core, etxc, vtxc, v ) !---------------------------------------------------------------------------- !! Exchange-Correlation potential Vxc(r) from n(r) From 2489d26f8700d6113d2b493c290ba4db92d45ec8 Mon Sep 17 00:00:00 2001 From: giannozz Date: Mon, 24 Jun 2019 16:50:22 +0200 Subject: [PATCH 24/95] Clarification on reasons behind broadcast perfromed after mixing --- PW/src/electrons.f90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/PW/src/electrons.f90 b/PW/src/electrons.f90 index 301b1315a6..a22545a64b 100644 --- a/PW/src/electrons.f90 +++ b/PW/src/electrons.f90 @@ -645,18 +645,21 @@ SUBROUTINE electrons_scf ( printout, exxen ) ! ! ... mix_rho mixes several quantities: rho in g-space, tauk (for ! ... meta-gga), ns and ns_nc (for lda+u) and becsum (for paw) - ! ... Results are broadcast from pool 0 to others to prevent trouble - ! ... on machines unable to yield the same results from the same - ! ... calculation on same data, performed on different procs - ! ... The mixing should be done on pool 0 only as well, but inside - ! ... mix_rho there is a call to rho_ddot that in the PAW case - ! ... contains a hidden parallelization level on the entire image + ! ... The mixing could in principle be done on pool 0 only, but + ! ... mix_rho contains a call to rho_ddot that in the PAW case + ! ... is parallelized on the entire image ! ! IF ( my_pool_id == root_pool ) CALL mix_rho ( rho, rhoin, mixing_beta, dr2, tr2_min, iter, nmix, & iunmix, conv_elec ) ! + ! ... Results are broadcast from pool 0 to others to prevent trouble + ! ... on machines unable to yield the same results for the same + ! ... calculations on the same data, performed on different procs + ! IF ( lda_plus_u ) THEN + ! ... For LDA+U, ns and ns_nc are also broadcast inside each pool + ! ... to ensure consistency on all processors of all pools IF (noncolin) THEN CALL mp_bcast( rhoin%ns_nc, my_pool_id, intra_pool_comm) ELSE @@ -672,8 +675,8 @@ SUBROUTINE electrons_scf ( printout, exxen ) ! ... if convergence is achieved or if the self-consistency error ! ... (dr2) is smaller than the estimated error due to diagonalization ! ... (tr2_min), rhoin and rho are unchanged: rhoin contains the input - ! ... density and rho contains the output density - ! ... In the other cases rhoin contains the mixed charge density + ! ... density and rho contains the output density. + ! ... In all other cases, rhoin contains the mixed charge density ! ... (the new input density) while rho is unchanged ! IF ( first .and. nat > 0) THEN From 48ef4e0f012f348bcb2038ba3f93ce5dc428e15e Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Tue, 25 Jun 2019 14:44:26 +0200 Subject: [PATCH 25/95] init_xc removed and some clean-up --- LR_Modules/setup_dgc.f90 | 8 +- Modules/dgcxc_drivers.f90 | 4 +- Modules/dmxc_drivers.f90 | 36 +++- Modules/funct.f90 | 106 ++-------- Modules/make.depend | 7 +- Modules/xc_gga_drivers.f90 | 351 ++++++++++++++----------------- Modules/xc_lda_lsda_drivers.f90 | 165 ++++++--------- Modules/xc_mgga_drivers.f90 | 79 ++----- PP/src/benchmark_libxc.f90 | 34 ++- PP/src/vasp_xml_module.f90 | 2 +- PP/src/xctest.f90 | 2 +- PW/src/paw_onecenter.f90 | 5 +- atomic/src/read_pseudo_rrkj3.f90 | 2 +- 13 files changed, 326 insertions(+), 475 deletions(-) diff --git a/LR_Modules/setup_dgc.f90 b/LR_Modules/setup_dgc.f90 index be05565c62..f75819efdd 100644 --- a/LR_Modules/setup_dgc.f90 +++ b/LR_Modules/setup_dgc.f90 @@ -23,8 +23,8 @@ SUBROUTINE setup_dgc USE noncollin_module, ONLY : noncolin, ux, nspin_gga, nspin_mag USE wavefunctions, ONLY : psic USE kinds, ONLY : DP - USE funct, ONLY : dft_is_gradient - USE xc_gga, ONLY : gcxc, gcx_spin, gcc_spin, libxc_switches_gga + USE funct, ONLY : dft_is_gradient, is_libxc + USE xc_gga, ONLY : gcxc, gcx_spin, gcc_spin USE uspp, ONLY : nlcc_any USE gc_lr, ONLY : grho, gmag, dvxc_rr, dvxc_sr, & dvxc_ss, dvxc_s, vsgga, segni @@ -50,8 +50,8 @@ SUBROUTINE setup_dgc ! CALL start_clock( 'setup_dgc' ) ! - IF ( SUM(libxc_switches_gga(:)) /= 0 ) CALL errore( 'setup_dgc', 'libxc derivatives of & - &xc potentials for GGA not implemented yet', 1 ) + IF ( ANY(is_libxc(3:4)) ) CALL errore( 'setup_dgc', 'libxc derivatives of & + &xc potentials for GGA not implemented yet', 1 ) ! IF (noncolin .AND. domag) THEN ALLOCATE( segni(dfftp%nnr) ) diff --git a/Modules/dgcxc_drivers.f90 b/Modules/dgcxc_drivers.f90 index e9ff755bde..3b681f93c2 100644 --- a/Modules/dgcxc_drivers.f90 +++ b/Modules/dgcxc_drivers.f90 @@ -8,8 +8,8 @@ SUBROUTINE dgcxc( length, r_in, s2_in, vrrx, vsrx, vssx, vrrc, vsrc, vssc ) !! This routine computes the derivative of the exchange and correlation !! potentials. ! - USE xc_gga, ONLY: gcxc, libxc_switches_gga USE kinds, ONLY: DP + USE xc_gga, ONLY: gcxc ! IMPLICIT NONE ! @@ -71,7 +71,7 @@ SUBROUTINE dgcxc_spin( length, r_in, g_in, vrrx, vrsx, vssx, vrrc, vrsc, & !! This routine computes the derivative of the exchange and correlation !! potentials in the spin-polarized case. ! - USE xc_gga, ONLY: gcx_spin, gcc_spin, libxc_switches_gga + USE xc_gga, ONLY: gcx_spin, gcc_spin USE kinds, ONLY: DP ! IMPLICIT NONE diff --git a/Modules/dmxc_drivers.f90 b/Modules/dmxc_drivers.f90 index fbb7e69418..93791d64fa 100644 --- a/Modules/dmxc_drivers.f90 +++ b/Modules/dmxc_drivers.f90 @@ -16,11 +16,12 @@ SUBROUTINE dmxc( length, sr_d, rho_in, dmuxc ) ! 1) iexch libxc + icorr libxc ! 2) iexch qe + icorr qe ! - USE kinds, ONLY: DP + USE kinds, ONLY: DP + USE funct, ONLY: get_iexch, get_icorr, is_libxc + USE xc_lda_lsda, ONLY: xc_lda, xc_lsda #if defined(__LIBXC) USE xc_f90_types_m USE xc_f90_lib_m - USE xc_lda_lsda #endif ! IMPLICIT NONE @@ -45,13 +46,16 @@ SUBROUTINE dmxc( length, sr_d, rho_in, dmuxc ) LOGICAL :: exch_lxc_avail, corr_lxc_avail #endif ! + INTEGER :: iexch, icorr INTEGER :: ir, length_lxc, length_dlxc REAL(DP), PARAMETER :: small = 1.E-10_DP, rho_trash = 0.5_DP ! + iexch = get_iexch() + icorr = get_icorr() ! #if defined(__LIBXC) ! - IF (libxc_switches_lda(1)==1 .AND. libxc_switches_lda(2)==1) THEN + IF (is_libxc(1) .AND. is_libxc(2)) THEN ! length_lxc = length*sr_d ! @@ -91,12 +95,12 @@ SUBROUTINE dmxc( length, sr_d, rho_in, dmuxc ) dmxc_lxc(length_dlxc) ) ! ! ... DERIVATIVE FOR EXCHANGE - CALL xc_f90_func_init( xc_func, xc_info1, iexch_l, pol_unpol ) + CALL xc_f90_func_init( xc_func, xc_info1, iexch, pol_unpol ) CALL xc_f90_lda_fxc( xc_func, length, rho_lxc(1), dmex_lxc(1) ) CALL xc_f90_func_end( xc_func ) ! ! ... DERIVATIVE FOR CORRELATION - CALL xc_f90_func_init( xc_func, xc_info2, icorr_l, pol_unpol ) + CALL xc_f90_func_init( xc_func, xc_info2, icorr, pol_unpol ) CALL xc_f90_lda_fxc( xc_func, length, rho_lxc(1), dmcr_lxc(1) ) CALL xc_f90_func_end( xc_func ) ! @@ -116,7 +120,7 @@ SUBROUTINE dmxc( length, sr_d, rho_in, dmuxc ) DEALLOCATE( dmex_lxc, dmcr_lxc, dmxc_lxc ) DEALLOCATE( rho_lxc ) ! - ELSEIF (libxc_switches_lda(1)==0 .AND. libxc_switches_lda(2)==0 ) THEN + ELSEIF ((.NOT.is_libxc(1)) .AND. (.NOT.is_libxc(2)) ) THEN ! IF ( sr_d == 1 ) CALL dmxc_lda( length, rho_in(:,1), dmuxc(:,1,1) ) IF ( sr_d == 2 ) CALL dmxc_lsda( length, rho_in, dmuxc ) @@ -163,7 +167,8 @@ SUBROUTINE dmxc_lda( length, rho_in, dmuxc ) !! Computes the derivative of the xc potential with respect to the !! local density. ! - USE xc_lda_lsda, ONLY: xc_lda, iexch_l, icorr_l + USE xc_lda_lsda, ONLY: xc_lda + USE funct, ONLY: get_iexch, get_icorr USE kinds, ONLY: DP ! IMPLICIT NONE @@ -183,7 +188,8 @@ SUBROUTINE dmxc_lda( length, rho_in, dmuxc ) ! REAL(DP) :: rho, rs, ex_s, vx_s REAL(DP) :: dpz - INTEGER :: iflg, ir, i1, i2, f1, f2 + INTEGER :: iexch, icorr + INTEGER :: iflg, ir, i1, i2, f1, f2 ! REAL(DP), PARAMETER :: small = 1.E-30_DP, e2 = 2.0_DP, & pi34 = 0.75_DP/3.141592653589793_DP, & @@ -196,12 +202,15 @@ SUBROUTINE dmxc_lda( length, rho_in, dmuxc ) ! ntids = omp_get_num_threads() #endif + ! + iexch = get_iexch() + icorr = get_icorr() ! dmuxc = 0.0_DP ! ! ... first case: analytical derivatives available ! - IF (iexch_l == 1 .AND. icorr_l == 1) THEN + IF (iexch == 1 .AND. icorr == 1) THEN ! !$omp parallel if(ntids==1) !$omp do private( rs, rho, ex_s, vx_s ) @@ -280,7 +289,8 @@ SUBROUTINE dmxc_lsda( length, rho_in, dmuxc ) !! local density in the spin-polarized case. ! USE kinds, ONLY: DP - USE xc_lda_lsda, ONLY: xc_lsda, iexch_l, icorr_l + USE funct, ONLY: get_iexch, get_icorr + USE xc_lda_lsda, ONLY: xc_lsda ! IMPLICIT NONE ! @@ -307,6 +317,7 @@ SUBROUTINE dmxc_lsda( length, rho_in, dmuxc ) ! REAL(DP) :: dpz, dpz_polarized ! + INTEGER :: iexch, icorr INTEGER :: ir, is, iflg INTEGER :: i1, i2, i3, i4 INTEGER :: f1, f2, f3, f4 @@ -317,11 +328,14 @@ SUBROUTINE dmxc_lsda( length, rho_in, dmuxc ) p49 = 4.0_DP/9.0_DP, m23 = -2.0_DP/3.0_DP, & rho_trash = 0.5_DP, zeta_trash = 0.5_DP ! + iexch = get_iexch() + icorr = get_icorr() + ! dmuxc = 0.0_DP null_v = 1.0_DP rhotot(:) = rho_in(:,1) + rho_in(:,2) ! - IF (iexch_l == 1 .AND. icorr_l == 1) THEN + IF (iexch == 1 .AND. icorr == 1) THEN ! ! ... first case: analytical derivative available ! diff --git a/Modules/funct.f90 b/Modules/funct.f90 index 044afb5e5d..cc5233679f 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -62,17 +62,18 @@ MODULE funct ! ! additional subroutines/functions for finite size corrections PUBLIC :: dft_has_finite_size_correction, set_finite_size_volume + PUBLIC :: get_finite_size_cell_volume ! rpa specific PUBLIC :: init_dft_exxrpa, enforce_dft_exxrpa ! ! driver subroutines computing XC - PUBLIC :: init_xc, is_libxc + PUBLIC :: is_libxc PUBLIC :: nlc ! ! PRIVATE variables defining the DFT functional ! - PRIVATE :: dft, iexch, icorr, igcx, igcc, imeta, inlc - PRIVATE :: discard_input_dft + PRIVATE :: iexch, icorr, igcx, igcc, imeta, imetac, inlc + PRIVATE :: dft, discard_input_dft PRIVATE :: isgradient, ismeta, ishybrid PRIVATE :: exx_fraction, exx_started PRIVATE :: has_finite_size_correction, & @@ -757,7 +758,7 @@ SUBROUTINE set_dft_from_name( dft_ ) CALL errore( 'set_dft_from_name', ' conflicting values for inlc', 1 ) ENDIF ! - CALL init_xc( 'ALL' ) + !CALL init_xc() ! RETURN ! @@ -1028,14 +1029,12 @@ SUBROUTINE start_exx IF (.NOT. ishybrid) & CALL errore( 'start_exx', 'dft is not hybrid, wrong call', 1 ) exx_started = .TRUE. - CALL init_xc( 'ALL' ) END SUBROUTINE start_exx !----------------------------------------------------------------------- SUBROUTINE stop_exx IF (.NOT. ishybrid) & CALL errore( 'stop_exx', 'dft is not hybrid, wrong call', 1 ) exx_started = .FALSE. - CALL init_xc( 'ALL' ) END SUBROUTINE stop_exx !----------------------------------------------------------------------- SUBROUTINE dft_force_hybrid( request ) @@ -1219,8 +1218,8 @@ SUBROUTINE get_finite_size_cell_volume( is_present, volume ) END SUBROUTINE get_finite_size_cell_volume ! !----------------------------------------------------------------------- - SUBROUTINE set_dft_from_indices( iexch_, icorr_, igcx_, igcc_, inlc_ ) - INTEGER :: iexch_, icorr_, igcx_, igcc_, inlc_ + SUBROUTINE set_dft_from_indices( iexch_, icorr_, igcx_, igcc_, imeta_, inlc_ ) + INTEGER :: iexch_, icorr_, igcx_, igcc_, imeta_, inlc_ IF ( discard_input_dft ) RETURN IF (iexch == notset) iexch = iexch_ IF (iexch /= iexch_) THEN @@ -1242,6 +1241,11 @@ SUBROUTINE set_dft_from_indices( iexch_, icorr_, igcx_, igcc_, inlc_ ) write (stdout,*) igcc, igcc_ CALL errore( 'set_dft', ' conflicting values for igcc', 1 ) ENDIF + IF (imeta == notset) imeta = imeta_ + IF (imeta /= imeta_) THEN + write (stdout,*) imeta, imeta_ + CALL errore( 'set_dft', ' conflicting values for imeta', 1 ) + ENDIF IF (inlc == notset) inlc = inlc_ IF (inlc /= inlc_) THEN write (stdout,*) inlc, inlc_ @@ -1411,92 +1415,6 @@ END SUBROUTINE write_dft_name ! ! !----------------------------------------------------------------------- -SUBROUTINE init_xc( family ) - !------------------------------------------------------------------- - !! Gets from inside parameters needed to initialize lda xc-drivers. - ! - USE kinds, ONLY: DP - USE xc_lda_lsda, ONLY: libxc_switches_lda, iexch_l, icorr_l, & - exx_started_l, is_there_finite_size_corr, & - exx_fraction_l, finite_size_cell_volume_l - USE xc_gga, ONLY: libxc_switches_gga, igcx_l, igcc_l, & - exx_started_g, exx_fraction_g, & - screening_parameter_l, gau_parameter_l - USE xc_mgga, ONLY: libxc_switches_mgga, imeta_l, imetac_l, & - exx_started_mg, exx_fraction_mg - ! - IMPLICIT NONE - ! - CHARACTER(LEN=*), INTENT(IN) :: family - ! - IF (family.EQ.'LDA' .OR. family.EQ.'ALL') THEN - ! =1 if libxc active, =0 otherwise - IF (is_libxc(1)) libxc_switches_lda(1) = 1 - IF (is_libxc(2)) libxc_switches_lda(2) = 1 - ! exchange-correlation indexes - iexch_l = get_iexch() - icorr_l = get_icorr() - ! - IF (iexch_l==notset .OR. icorr_l==notset) CALL errore( 'init_xc', 'LDA functional & - & indexes not defined', 1 ) - ! - ! hybrid exchange vars - exx_started_l = exx_started !is_active() - exx_fraction_l = 0._DP - IF ( exx_started_l ) exx_fraction_l = get_exx_fraction() - ! - ! finite size correction vars - CALL get_finite_size_cell_volume( is_there_finite_size_corr, & - finite_size_cell_volume_l ) - ENDIF - ! - IF (family.EQ.'GGA' .OR. family.EQ.'ALL') THEN - ! =1 if libxc active, =0 otherwise - IF (is_libxc(3)) libxc_switches_gga(1) = 1 - IF (is_libxc(4)) libxc_switches_gga(2) = 1 - ! exchange-correlation indexes - igcx_l = get_igcx() - igcc_l = get_igcc() - ! - IF (igcx_l==notset .OR. igcc_l==notset) CALL errore( 'init_xc', 'GGA functional & - & indexes not defined', 2 ) - ! - ! hybrid exchange vars - exx_started_g = exx_started !is_active() - exx_fraction_g = 0._DP - IF ( exx_started_g ) exx_fraction_g = get_exx_fraction() - ! - screening_parameter_l = get_screening_parameter() - gau_parameter_l = get_gau_parameter() - ENDIF - ! - IF (family.EQ.'MGGA' .OR. family.EQ.'ALL') THEN - ! =1 if libxc active, =0 otherwise - IF (is_libxc(5)) libxc_switches_mgga(1) = 1 - IF (is_libxc(6)) libxc_switches_mgga(2) = 1 - ! exchange-correlation indexes - imeta_l = get_meta() - imetac_l = get_metac() - ! - IF (imeta_l==notset .OR. imetac_l==notset) CALL errore( 'init_xc', 'MGGA functional & - & indexes not defined', 3 ) - ! - ! hybrid exchange vars - exx_started_mg = exx_started !is_active() - exx_fraction_mg = 0._DP - IF ( exx_started_mg ) exx_fraction_mg = get_exx_fraction() - ! - ENDIF - ! - IF ( family.NE.'LDA' .AND. family.NE.'GGA' .AND. family.NE.'MGGA' .AND. family.NE.'ALL') & - CALL errore( 'init_xc', 'family not found', 4 ) - ! - RETURN - ! -END SUBROUTINE init_xc -! -! -!----------------------------------------------------------------------- !------- NONLOCAL CORRECTIONS DRIVERS ---------------------------------- !----------------------------------------------------------------------- ! diff --git a/Modules/make.depend b/Modules/make.depend index 0bc51f97da..163d959ad6 100644 --- a/Modules/make.depend +++ b/Modules/make.depend @@ -66,6 +66,7 @@ dist.o : io_global.o dist.o : ions_base.o dist.o : kind.o dmxc_drivers.o : constants.o +dmxc_drivers.o : funct.o dmxc_drivers.o : kind.o dmxc_drivers.o : libxc.o dmxc_drivers.o : xc_lda_lsda_drivers.o @@ -111,9 +112,6 @@ fox_init_module.o : mp_images.o funct.o : io_global.o funct.o : kind.o funct.o : libxc.o -funct.o : xc_gga_drivers.o -funct.o : xc_lda_lsda_drivers.o -funct.o : xc_mgga_drivers.o funct.o : xc_rVV10.o funct.o : xc_vdW_DF.o generate_function.o : ../UtilXlib/mp.o @@ -442,10 +440,13 @@ ws_base.o : kind.o wyckoff.o : kind.o wyckoff.o : space_group.o wypos.o : kind.o +xc_gga_drivers.o : funct.o xc_gga_drivers.o : kind.o xc_gga_drivers.o : libxc.o +xc_lda_lsda_drivers.o : funct.o xc_lda_lsda_drivers.o : kind.o xc_lda_lsda_drivers.o : libxc.o +xc_mgga_drivers.o : funct.o xc_mgga_drivers.o : kind.o xc_mgga_drivers.o : libxc.o xc_rVV10.o : ../FFTXlib/fft_interfaces.o diff --git a/Modules/xc_gga_drivers.f90 b/Modules/xc_gga_drivers.f90 index 36b43464df..73803face7 100644 --- a/Modules/xc_gga_drivers.f90 +++ b/Modules/xc_gga_drivers.f90 @@ -1,6 +1,9 @@ MODULE xc_gga ! -USE kinds, ONLY: DP +USE kinds, ONLY: DP +USE funct, ONLY: get_igcx, get_igcc, is_libxc, & + exx_is_active, get_exx_fraction, & + get_screening_parameter, get_gau_parameter ! IMPLICIT NONE ! @@ -9,77 +12,16 @@ MODULE xc_gga ! ! GGA exchange-correlation drivers PUBLIC :: xc_gcx, gcxc, gcx_spin, gcc_spin, gcc_spin_more, & - select_gga_functionals, change_threshold_gga -! -PUBLIC :: libxc_switches_gga -PUBLIC :: igcx_l, igcc_l -PUBLIC :: exx_started_g, exx_fraction_g -PUBLIC :: screening_parameter_l, gau_parameter_l -! -! libxc on/off -INTEGER :: libxc_switches_gga(2) -! -! indexes defining xc functionals -INTEGER :: igcx_l, igcc_l + change_threshold_gga ! ! input thresholds (default values) REAL(DP) :: rho_threshold = 1.D-6 REAL(DP) :: grho_threshold = 1.D-10 ! -! variables for hybrid exchange -LOGICAL :: exx_started_g -REAL(DP) :: exx_fraction_g -! -! screening_ and gau_parameters -REAL(DP) :: screening_parameter_l, gau_parameter_l -! ! CONTAINS ! ! -!---------------------------------------------------------------------------- -!----- Select functionals by the corresponding indexes ---------------------- -!---------------------------------------------------------------------------- -SUBROUTINE select_gga_functionals( igcx, igcc, exx_fraction, screening_parameter, & - gau_parameter ) - !----------------------------------------------------------------------------- - ! - IMPLICIT NONE - ! - INTEGER, INTENT(IN) :: igcx, igcc - REAL(DP), INTENT(IN), OPTIONAL :: exx_fraction - REAL(DP), INTENT(IN), OPTIONAL :: screening_parameter - REAL(DP), INTENT(IN), OPTIONAL :: gau_parameter - ! - ! exchange-correlation indexes - igcx_l = igcx - igcc_l = igcc - ! - ! hybrid exchange vars - exx_started_g = .FALSE. - exx_fraction_g = 0._DP - IF ( PRESENT(exx_fraction) ) THEN - exx_started_g = .TRUE. - exx_fraction_g = exx_fraction - ENDIF - ! - ! screening_ and gau_parameter - screening_parameter_l = 0.0_DP - gau_parameter_l = 0.0_DP - ! - IF ( PRESENT(screening_parameter) ) THEN - screening_parameter_l = screening_parameter - ENDIF - ! - IF ( PRESENT(gau_parameter) ) THEN - gau_parameter_l = gau_parameter - ENDIF - ! - RETURN - ! -END SUBROUTINE select_gga_functionals -! -! !----------------------------------------------------------------------- SUBROUTINE change_threshold_gga( rho_thr_in, grho_thr_in ) !-------------------------------------------------------------------- @@ -161,6 +103,7 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) REAL(DP), ALLOCATABLE :: rh(:), zeta(:) REAL(DP), ALLOCATABLE :: grho2(:,:), grho_ud(:) ! + INTEGER :: igcx, igcc INTEGER :: k, is REAL(DP), PARAMETER :: small = 1.E-10_DP ! @@ -168,6 +111,9 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) IF (ns==2 .AND. .NOT. PRESENT(v2c_ud)) CALL errore( 'xc_gga', 'cross & &term v2c_ud not found', 1 ) ! + igcx = get_igcx() + igcc = get_igcc() + ! #if defined(__LIBXC) ! POLARIZED = .FALSE. @@ -212,14 +158,14 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) ! ENDIF ! - IF ( ns==1 .AND. SUM(libxc_switches_gga(:))/=2) & + IF ( ns==1 .AND. ANY(.NOT.is_libxc(3:4)) ) & CALL gcxc( length, rho(:,1), sigma, ex, ec, v1x(:,1), v2x(:,1), v1c(:,1), v2c(:,1) ) ! ! --- GGA EXCHANGE ! - IF ( libxc_switches_gga(1) == 1 ) THEN + IF ( is_libxc(3) ) THEN ! - CALL xc_f90_func_init( xc_func, xc_info1, igcx_l, pol_unpol ) + CALL xc_f90_func_init( xc_func, xc_info1, igcx, pol_unpol ) CALL xc_f90_func_set_dens_threshold( xc_func, rho_threshold ) fkind_x = xc_f90_info_kind( xc_info1 ) CALL xc_f90_gga_exc_vxc( xc_func, length, rho_lxc(1), sigma(1), ex_lxc(1), vx_rho(1), vx_sigma(1) ) @@ -261,9 +207,9 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) ! ! ---- GGA CORRELATION ! - IF ( libxc_switches_gga(2) == 1 ) THEN !lda part of LYP not present in libxc + IF ( is_libxc(4) ) THEN !lda part of LYP not present in libxc ! - CALL xc_f90_func_init( xc_func, xc_info2, igcc_l, pol_unpol ) + CALL xc_f90_func_init( xc_func, xc_info2, igcc, pol_unpol ) CALL xc_f90_func_set_dens_threshold( xc_func, rho_threshold ) CALL xc_f90_gga_exc_vxc( xc_func, length, rho_lxc(1), sigma(1), ec_lxc(1), vc_rho(1), vc_sigma(1) ) CALL xc_f90_func_end( xc_func ) @@ -288,7 +234,7 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) ENDDO ENDIF ! - ELSEIF ( libxc_switches_gga(2)==0 .AND. fkind_x/=XC_EXCHANGE_CORRELATION ) THEN + ELSEIF ( (.NOT.is_libxc(4)) .AND. fkind_x/=XC_EXCHANGE_CORRELATION ) THEN ! ALLOCATE( arho(length,ns), grho2(length,ns) ) ! @@ -298,7 +244,7 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) grho2(:,is) = grho(1,:,is)**2 + grho(2,:,is)**2 + grho(3,:,is)**2 ENDDO ! - IF (igcc_l==3 .OR. igcc_l==7 .OR. igcc_l==13 ) THEN + IF (igcc==3 .OR. igcc==7 .OR. igcc==13 ) THEN ! ALLOCATE( grho_ud(length) ) ! @@ -373,7 +319,7 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) ! CALL gcx_spin( length, rho, grho2, ex, v1x, v2x ) ! - IF (igcc_l==3 .OR. igcc_l==7 .OR. igcc_l==13 ) THEN + IF (igcc==3 .OR. igcc==7 .OR. igcc==13 ) THEN ! ALLOCATE( grho_ud(length) ) ! @@ -447,25 +393,33 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! ! ... local variables ! - INTEGER :: ir + INTEGER :: ir, igcx, igcc REAL(DP) :: rho, grho, sgn REAL(DP) :: sx, v1x, v2x REAL(DP) :: sx_, v1x_, v2x_ REAL(DP) :: sxsr, v1xsr, v2xsr REAL(DP) :: sc, v1c, v2c + REAL(DP) :: screening_parameter, gau_parameter + REAL(DP) :: exx_fraction + LOGICAL :: exx_started + #if defined(_OPENMP) INTEGER :: ntids INTEGER, EXTERNAL :: omp_get_num_threads -#endif ! -#if defined(_OPENMP) ntids = omp_get_num_threads() #endif ! + igcx = get_igcx() + igcc = get_igcc() + exx_started = exx_is_active() + exx_fraction = get_exx_fraction() + IF (igcx == 12) screening_parameter = get_screening_parameter() + IF (igcx == 20) gau_parameter = get_gau_parameter() ! !$omp parallel if(ntids==1) !$omp do private( rho, grho, sx, sx_, sxsr, v1x, v1x_, v1xsr, & -!$omp v2x, v2x_, v2xsr, sc, v1c, v2c ) +!$omp v2x, v2x_, v2xsr, sc, v1c, v2c, exx_fraction ) DO ir = 1, length ! rho = ABS(rho_in(ir)) @@ -482,7 +436,7 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! ! ... EXCHANGE ! - SELECT CASE( igcx_l ) + SELECT CASE( igcx ) CASE( 1 ) ! CALL becke88( rho, grho, sx, v1x, v2x ) @@ -501,27 +455,27 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! CASE( 5 ) ! - IF (igcc_l == 5) CALL hcth( rho, grho, sx, v1x, v2x ) + IF (igcc == 5) CALL hcth( rho, grho, sx, v1x, v2x ) ! CASE( 6 ) ! CALL optx( rho, grho, sx, v1x, v2x ) ! - ! case igcx_l == 7 (meta-GGA) must be treated in a separate call to another + ! case igcx == 7 (meta-GGA) must be treated in a separate call to another ! routine: needs kinetic energy density in addition to rho and grad rho CASE( 8 ) ! 'PBE0' ! CALL pbex( rho, grho, 1, sx, v1x, v2x ) - IF (exx_started_g) THEN - sx = (1.0_DP - exx_fraction_g) * sx - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF (exx_started) THEN + sx = (1.0_DP - exx_fraction) * sx + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 9 ) ! 'B3LYP' ! CALL becke88( rho, grho, sx, v1x, v2x ) - IF (exx_started_g) THEN + IF (exx_started) THEN sx = 0.72_DP * sx v1x = 0.72_DP * v1x v2x = 0.72_DP * v2x @@ -539,11 +493,11 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! CALL pbex( rho, grho, 1, sx, v1x, v2x ) ! - IF (exx_started_g) THEN - CALL pbexsr( rho, grho, sxsr, v1xsr, v2xsr, screening_parameter_l ) - sx = sx - exx_fraction_g * sxsr - v1x = v1x - exx_fraction_g * v1xsr - v2x = v2x - exx_fraction_g * v2xsr + IF (exx_started) THEN + CALL pbexsr( rho, grho, sxsr, v1xsr, v2xsr, screening_parameter ) + sx = sx - exx_fraction * sxsr + v1x = v1x - exx_fraction * v1xsr + v2x = v2x - exx_fraction * v2xsr ENDIF ! CASE( 13 ) ! 'rPW86' @@ -565,11 +519,11 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & CASE( 20 ) ! 'gau-pbe' ! CALL pbex( rho, grho, 1, sx, v1x, v2x ) - IF (exx_started_g) THEN - CALL pbexgau( rho, grho, sxsr, v1xsr, v2xsr, gau_parameter_l ) - sx = sx - exx_fraction_g * sxsr - v1x = v1x - exx_fraction_g * v1xsr - v2x = v2x - exx_fraction_g * v2xsr + IF (exx_started) THEN + CALL pbexgau( rho, grho, sxsr, v1xsr, v2xsr, gau_parameter ) + sx = sx - exx_fraction * sxsr + v1x = v1x - exx_fraction * v1xsr + v2x = v2x - exx_fraction * v2xsr ENDIF ! CASE( 21 ) ! 'pw86' @@ -606,7 +560,7 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! CALL becke88( rho, grho, sx, v1x, v2x ) CALL pbex( rho, grho, 1, sx_, v1x_, v2x_ ) - IF (exx_started_g) THEN + IF (exx_started) THEN sx = REAL(0.765*0.709,DP) * sx v1x = REAL(0.765*0.709,DP) * v1x v2x = REAL(0.765*0.709,DP) * v2x @@ -618,56 +572,56 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & CASE( 29, 31 ) ! 'cx0'or `cx0p' ! CALL cx13( rho, grho, sx, v1x, v2x ) - IF (exx_started_g) THEN - sx = (1.0_DP - exx_fraction_g) * sx - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF (exx_started) THEN + sx = (1.0_DP - exx_fraction) * sx + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 30 ) ! 'r860' ! CALL rPW86( rho, grho, sx, v1x, v2x ) ! - IF (exx_started_g) then - sx = (1.0_DP - exx_fraction_g) * sx - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF (exx_started) then + sx = (1.0_DP - exx_fraction) * sx + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 38 ) ! 'BR0' ! CALL b86b( rho, grho, 3, sx, v1x, v2x ) - IF (exx_started_g) THEN - sx = (1.0_DP - exx_fraction_g) * sx - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF (exx_started) THEN + sx = (1.0_DP - exx_fraction) * sx + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 40 ) ! 'c090' ! CALL c09x( rho, grho, sx, v1x, v2x ) - IF (exx_started_g) THEN - sx = (1.0_DP - exx_fraction_g) * sx - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF (exx_started) THEN + sx = (1.0_DP - exx_fraction) * sx + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 41 ) ! 'B86BPBEX' ! CALL becke86b( rho, grho, sx, v1x, v2x ) - IF (exx_started_g) THEN - sx = (1.0_DP - exx_fraction_g) * sx - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF (exx_started) THEN + sx = (1.0_DP - exx_fraction) * sx + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 42 ) ! 'BHANDHLYP' ! CALL becke88( rho, grho, sx, v1x, v2x ) - IF (exx_started_g) THEN - sx = (1.0_DP - exx_fraction_g) * sx - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF (exx_started) THEN + sx = (1.0_DP - exx_fraction) * sx + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE DEFAULT @@ -681,7 +635,7 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! ! ... CORRELATION ! - SELECT CASE( igcc_l ) + SELECT CASE( igcc ) CASE( 1 ) ! CALL perdew86( rho, grho, sc, v1c, v2c ) @@ -698,12 +652,12 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! CALL pbec( rho, grho, 1, sc, v1c, v2c ) ! - ! igcc_l == 5 (HCTH) is calculated together with case igcx_l=5 - ! igcc_l == 6 (meta-GGA) is treated in a different routine + ! igcc == 5 (HCTH) is calculated together with case igcx=5 + ! igcc == 6 (meta-GGA) is treated in a different routine CASE( 7 ) !'B3LYP' ! CALL glyp( rho, grho, sc, v1c, v2c ) - IF (exx_started_g) THEN + IF (exx_started) THEN sc = 0.81_DP * sc v1c = 0.81_DP * v1c v2c = 0.81_DP * v2c @@ -713,9 +667,9 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! CALL pbec( rho, grho, 2, sc, v1c, v2c ) ! - ! igcc_l == 9 set to 5, back-compatibility - ! igcc_l == 10 set to 6, back-compatibility - ! igcc_l == 11 M06L calculated in another routine + ! igcc == 9 set to 5, back-compatibility + ! igcc == 10 set to 6, back-compatibility + ! igcc == 11 M06L calculated in another routine CASE( 12 ) ! 'Q2D' ! CALL pbec( rho, grho, 3, sc, v1c, v2c ) @@ -723,7 +677,7 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & CASE( 13 ) !'X3LYP' ! CALL glyp( rho, grho, sc, v1c, v2c ) - IF (exx_started_g) THEN + IF (exx_started) THEN sc = 0.871_DP * sc v1c = 0.871_DP * v1c v2c = 0.871_DP * v2c @@ -775,12 +729,15 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) ! ! ... local variables ! - INTEGER :: ir, is, iflag + INTEGER :: ir, is, iflag, igcx, igcc REAL(DP) :: rho(2), grho2(2) REAL(DP) :: v1x(2), v2x(2) REAL(DP) :: sx(2), rnull(2) REAL(DP) :: sxsr(2) REAL(DP) :: v1xsr(2), v2xsr(2) + REAL(DP) :: screening_parameter, gau_parameter + REAL(DP) :: exx_fraction + LOGICAL :: exx_started ! REAL(DP), PARAMETER :: small=1.D-10 REAL(DP), PARAMETER :: rho_trash=0.5_DP, grho2_trash=0.2_DP @@ -789,17 +746,22 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) #if defined(_OPENMP) INTEGER :: ntids INTEGER, EXTERNAL :: omp_get_num_threads -#endif ! - sx_tot = 0.0_DP - ! -#if defined(_OPENMP) ntids = omp_get_num_threads() #endif ! + sx_tot = 0.0_DP + ! + igcx = get_igcx() + igcc = get_igcc() + exx_started = exx_is_active() + exx_fraction = get_exx_fraction() + IF (igcx == 12 .AND. exx_started) screening_parameter = get_screening_parameter() + IF (igcx == 20 .AND. exx_started) gau_parameter = get_gau_parameter() + ! !$omp parallel if(ntids==1) !$omp do private( rho, grho2, sx, sxsr, v1x, v1xsr, & -!$omp v2x, v2xsr ) +!$omp v2x, v2xsr, exx_fraction ) DO ir = 1, length ! rho(:) = rho_in(ir,:) @@ -823,7 +785,7 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) ! ! ... exchange ! - SELECT CASE( igcx_l ) + SELECT CASE( igcx ) CASE( 0 ) ! sx_tot(ir) = 0.0_DP @@ -848,15 +810,15 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) v2x = 2.0_DP * v2x ! CASE( 3, 4, 8, 10, 12, 20, 23, 24, 25 ) - ! igcx_l=3: PBE, igcx_l=4: revised PBE, igcx_l=8: PBE0, igcx_l=10: PBEsol - ! igcx_l=12: HSE, igcx_l=20: gau-pbe, igcx_l=23: obk8, igcx_l=24: ob86, igcx_l=25: ev93 + ! igcx=3: PBE, igcx=4: revised PBE, igcx=8: PBE0, igcx=10: PBEsol + ! igcx=12: HSE, igcx=20: gau-pbe, igcx=23: obk8, igcx=24: ob86, igcx=25: ev93 ! iflag = 1 - IF ( igcx_l== 4 ) iflag = 2 - IF ( igcx_l==10 ) iflag = 3 - IF ( igcx_l==23 ) iflag = 5 - IF ( igcx_l==24 ) iflag = 6 - IF ( igcx_l==25 ) iflag = 7 + IF ( igcx== 4 ) iflag = 2 + IF ( igcx==10 ) iflag = 3 + IF ( igcx==23 ) iflag = 5 + IF ( igcx==24 ) iflag = 6 + IF ( igcx==25 ) iflag = 7 ! rho = 2.0_DP * rho grho2 = 4.0_DP * grho2 @@ -867,34 +829,34 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) sx_tot(ir) = 0.5_DP * ( sx(1)*rnull(1) + sx(2)*rnull(2) ) v2x = 2.0_DP * v2x ! - IF ( igcx_l == 8 .AND. exx_started_g ) THEN + IF ( igcx == 8 .AND. exx_started ) THEN ! - sx_tot(ir) = (1.0_DP - exx_fraction_g) * sx_tot(ir) - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + sx_tot(ir) = (1.0_DP - exx_fraction) * sx_tot(ir) + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ! - ELSEIF ( igcx_l == 12 .AND. exx_started_g ) THEN + ELSEIF ( igcx == 12 .AND. exx_started ) THEN ! CALL pbexsr( rho(1), grho2(1), sxsr(1), v1xsr(1), & - v2xsr(1), screening_parameter_l ) + v2xsr(1), screening_parameter ) CALL pbexsr( rho(2), grho2(2), sxsr(2), v1xsr(2), & - v2xsr(2), screening_parameter_l ) + v2xsr(2), screening_parameter ) ! - sx_tot(ir) = sx_tot(ir) - exx_fraction_g*0.5_DP * ( sxsr(1)*rnull(1) + & + sx_tot(ir) = sx_tot(ir) - exx_fraction*0.5_DP * ( sxsr(1)*rnull(1) + & sxsr(2)*rnull(2) ) - v1x = v1x - exx_fraction_g * v1xsr - v2x = v2x - exx_fraction_g * v2xsr * 2.0_DP + v1x = v1x - exx_fraction * v1xsr + v2x = v2x - exx_fraction * v2xsr * 2.0_DP ! - ELSEIF ( igcx_l == 20 .AND. exx_started_g ) THEN + ELSEIF ( igcx == 20 .AND. exx_started ) THEN ! gau-pbe !CALL pbexgau_lsd( rho, grho2, sxsr, v1xsr, v2xsr, gau_parameter_l ) - CALL pbexgau( rho(1), grho2(1), sxsr(1), v1xsr(1), v2xsr(1), gau_parameter_l ) - CALL pbexgau( rho(2), grho2(2), sxsr(2), v1xsr(2), v2xsr(2), gau_parameter_l ) + CALL pbexgau( rho(1), grho2(1), sxsr(1), v1xsr(1), v2xsr(1), gau_parameter ) + CALL pbexgau( rho(2), grho2(2), sxsr(2), v1xsr(2), v2xsr(2), gau_parameter ) ! - sx_tot(ir) = sx_tot(ir) - exx_fraction_g*0.5_DP * ( sxsr(1)*rnull(1) + & + sx_tot(ir) = sx_tot(ir) - exx_fraction*0.5_DP * ( sxsr(1)*rnull(1) + & sxsr(2)*rnull(2) ) - v1x = v1x - exx_fraction_g * v1xsr - v2x = v2x - exx_fraction_g * v2xsr * 2.0_DP + v1x = v1x - exx_fraction * v1xsr + v2x = v2x - exx_fraction * v2xsr * 2.0_DP ! ENDIF ! @@ -904,7 +866,7 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) ! sx_tot(ir) = sx(1)*rnull(1) + sx(2)*rnull(2) ! - IF ( exx_started_g ) THEN + IF ( exx_started ) THEN sx_tot(ir) = 0.72_DP * sx_tot(ir) v1x = 0.72_DP * v1x v2x = 0.72_DP * v2x @@ -1002,7 +964,7 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) v1x = v1xsr * 0.235_DP + v1x * 0.765_DP v2x = v2xsr * 0.235_DP * 2.0_DP + v2x * 0.765_DP ! - IF ( exx_started_g ) THEN + IF ( exx_started ) THEN sx_tot(ir) = 0.709_DP * sx_tot(ir) v1x = 0.709_DP * v1x v2x = 0.709_DP * v2x @@ -1019,10 +981,10 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) sx_tot(ir) = 0.5_DP * ( sx(1)*rnull(1) + sx(2)*rnull(2) ) v2x = 2.0_DP * v2x ! - IF ( exx_started_g ) THEN - sx_tot(ir) = (1.0_DP - exx_fraction_g) * sx_tot(ir) - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF ( exx_started ) THEN + sx_tot(ir) = (1.0_DP - exx_fraction) * sx_tot(ir) + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 30 ) ! 'R860' = 'rPW86-0' for vdw-df2-0' @@ -1036,10 +998,10 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) sx_tot(ir) = 0.5_DP * ( sx(1)*rnull(1) + sx(2)*rnull(2) ) v2x = 2.0_DP * v2x ! - IF ( exx_started_g ) THEN - sx_tot(ir) = (1.0_DP - exx_fraction_g) * sx_tot(ir) - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF ( exx_started ) THEN + sx_tot(ir) = (1.0_DP - exx_fraction) * sx_tot(ir) + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 38 ) ! 'br0 for vdw-df2-BR0' etc @@ -1053,10 +1015,10 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) sx_tot(ir) = 0.5_DP * ( sx(1)*rnull(1) + sx(2)*rnull(2) ) v2x = 2.0_DP * v2x ! - IF ( exx_started_g ) THEN - sx_tot(ir) = (1.0_DP - exx_fraction_g) * sx_tot(ir) - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF ( exx_started ) THEN + sx_tot(ir) = (1.0_DP - exx_fraction) * sx_tot(ir) + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 40 ) ! 'c090 for vdw-df-c090' etc @@ -1070,10 +1032,10 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) sx_tot(ir) = 0.5_DP * ( sx(1)*rnull(1) + sx(2)*rnull(2) ) v2x = 2.0_DP * v2x ! - IF ( exx_started_g ) THEN - sx_tot(ir) = (1.0_DP - exx_fraction_g) * sx_tot(ir) - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF ( exx_started ) THEN + sx_tot(ir) = (1.0_DP - exx_fraction) * sx_tot(ir) + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 41 ) ! B86X for B86BPBEX hybrid @@ -1087,10 +1049,10 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) sx_tot = 0.5_DP * ( sx(1)*rnull(1) + sx(2)*rnull(2) ) v2x = 2.0_DP * v2x ! - IF ( exx_started_g ) THEN - sx_tot = (1.0_DP - exx_fraction_g) * sx_tot - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF ( exx_started ) THEN + sx_tot = (1.0_DP - exx_fraction) * sx_tot + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! CASE( 42 ) ! B88X for BHANDHLYP @@ -1104,18 +1066,18 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) sx_tot = 0.5_DP * ( sx(1)*rnull(1) + sx(2)*rnull(2) ) v2x = 2.0_DP * v2x ! - IF ( exx_started_g ) THEN - sx_tot = (1.0_DP - exx_fraction_g) * sx_tot - v1x = (1.0_DP - exx_fraction_g) * v1x - v2x = (1.0_DP - exx_fraction_g) * v2x + IF ( exx_started ) THEN + sx_tot = (1.0_DP - exx_fraction) * sx_tot + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x ENDIF ! - ! case igcx_l == 5 (HCTH) and 6 (OPTX) not implemented - ! case igcx_l == 7 (meta-GGA) must be treated in a separate call to another + ! case igcx == 5 (HCTH) and 6 (OPTX) not implemented + ! case igcx == 7 (meta-GGA) must be treated in a separate call to another ! routine: needs kinetic energy density in addition to rho and grad rho CASE DEFAULT ! - CALL errore( 'gcx_spin', 'not implemented', igcx_l ) + CALL errore( 'gcx_spin', 'not implemented', igcx ) ! END SELECT ! @@ -1157,7 +1119,7 @@ SUBROUTINE gcc_spin( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out ! ! ... local variables ! - INTEGER :: ir + INTEGER :: ir, igcc REAL(DP) :: rho, zeta, grho REAL(DP) :: sc, v1c(2), v2c !REAL(DP), PARAMETER :: small=1.E-10_DP !, epsr=1.E-6_DP @@ -1169,6 +1131,8 @@ SUBROUTINE gcc_spin( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out ntids = omp_get_num_threads() #endif ! + igcc = get_igcc() + ! !$omp parallel if(ntids==1) !$omp do private( rho, zeta, grho, sc, v1c, v2c ) DO ir = 1, length @@ -1185,7 +1149,7 @@ SUBROUTINE gcc_spin( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out CYCLE ENDIF ! - SELECT CASE( igcc_l ) + SELECT CASE( igcc ) CASE( 0 ) ! sc = 0.0_DP @@ -1210,7 +1174,7 @@ SUBROUTINE gcc_spin( length, rho_in, zeta_io, grho_in, sc_out, v1c_out, v2c_out ! CASE DEFAULT ! - CALL errore( 'xc_gga_drivers (gcc_spin)', 'not implemented', igcc_l ) + CALL errore( 'xc_gga_drivers (gcc_spin)', 'not implemented', igcc ) ! END SELECT ! @@ -1262,18 +1226,21 @@ SUBROUTINE gcc_spin_more( length, rho_in, grho_in, grho_ud_in, & ! ! ... local variables ! - INTEGER :: ir + INTEGER :: ir, igcc REAL(DP) :: rho(2), grho(2) REAL(DP) :: grho_ud + LOGICAL :: exx_started #if defined(_OPENMP) INTEGER :: ntids INTEGER, EXTERNAL :: omp_get_num_threads #endif ! + igcc = get_igcc() sc = 0.0_DP v1c = 0.0_DP v2c = 0.0_DP v2c_ud = 0.0_DP + exx_started = exx_is_active() ! #if defined(_OPENMP) ntids = omp_get_num_threads() @@ -1296,14 +1263,14 @@ SUBROUTINE gcc_spin_more( length, rho_in, grho_in, grho_ud_in, & ! CALL lsd_glyp( rho, grho, grho_ud, sc(ir), v1c(ir,:), v2c(ir,:), v2c_ud(ir) ) ! - SELECT CASE( igcc_l ) + SELECT CASE( igcc ) CASE( 3 ) ! ! ... void ! CASE( 7 ) ! - IF ( exx_started_g ) THEN + IF ( exx_started ) THEN sc(ir) = 0.81_DP * sc(ir) v1c(ir,:) = 0.81_DP * v1c(ir,:) v2c(ir,:) = 0.81_DP * v2c(ir,:) @@ -1312,7 +1279,7 @@ SUBROUTINE gcc_spin_more( length, rho_in, grho_in, grho_ud_in, & ! CASE( 13 ) ! - IF ( exx_started_g ) THEN + IF ( exx_started ) THEN sc(ir) = 0.871_DP * sc(ir) v1c(ir,:) = 0.871_DP * v1c(ir,:) v2c(ir,:) = 0.871_DP * v2c(ir,:) diff --git a/Modules/xc_lda_lsda_drivers.f90 b/Modules/xc_lda_lsda_drivers.f90 index b01d42245c..996bbdb78f 100644 --- a/Modules/xc_lda_lsda_drivers.f90 +++ b/Modules/xc_lda_lsda_drivers.f90 @@ -9,6 +9,9 @@ MODULE xc_lda_lsda ! USE kinds, ONLY: DP +USE funct, ONLY: get_iexch, get_icorr, is_libxc, & + exx_is_active, get_exx_fraction, & + get_finite_size_cell_volume ! IMPLICIT NONE ! @@ -16,67 +19,15 @@ MODULE xc_lda_lsda SAVE ! ! LDA and LSDA exchange-correlation drivers -PUBLIC :: xc, xc_lda, xc_lsda, select_lda_functionals +PUBLIC :: xc, xc_lda, xc_lsda PUBLIC :: change_threshold_lda ! -PUBLIC :: libxc_switches_lda -PUBLIC :: iexch_l, icorr_l -PUBLIC :: exx_started_l, exx_fraction_l -PUBLIC :: is_there_finite_size_corr, finite_size_cell_volume_l -! -! use qe or libxc for the different terms (0: qe, 1: libxc) -INTEGER :: libxc_switches_lda(2) -! -! indexes defining xc functionals -INTEGER :: iexch_l, icorr_l -! ! density threshold (set to default value) REAL(DP) :: rho_threshold = 1.E-10_DP -! -! variables for hybrid exchange and finite_size_cell_volume correction -LOGICAL :: exx_started_l, is_there_finite_size_corr -REAL(DP) :: exx_fraction_l, finite_size_cell_volume_l -! ! CONTAINS ! ! -!---------------------------------------------------------------------------- -!----- Select functionals by the corresponding indexes ---------------------- -!---------------------------------------------------------------------------- -SUBROUTINE select_lda_functionals( iexch, icorr, exx_fraction, finite_size_cell_volume ) - ! - IMPLICIT NONE - ! - INTEGER, INTENT(IN) :: iexch, icorr - REAL(DP), INTENT(IN), OPTIONAL :: exx_fraction, finite_size_cell_volume - ! - ! exchange-correlation indexes - iexch_l = iexch - icorr_l = icorr - ! - ! hybrid exchange vars - exx_started_l = .FALSE. - exx_fraction_l = 0._DP - IF ( PRESENT(exx_fraction) ) THEN - exx_started_l = .TRUE. - exx_fraction_l = exx_fraction - ENDIF - ! - ! finite size correction vars - is_there_finite_size_corr = .FALSE. - finite_size_cell_volume_l = -1.0_DP - IF ( PRESENT(finite_size_cell_volume) ) THEN - is_there_finite_size_corr = .TRUE. - finite_size_cell_volume_l = finite_size_cell_volume - ENDIF - ! - ! - RETURN - ! -END SUBROUTINE select_lda_functionals -! -! !----------------------------------------------------------------------- SUBROUTINE change_threshold_lda( rho_thr_in ) !-------------------------------------------------------------------- @@ -139,12 +90,14 @@ SUBROUTINE xc( length, sr_d, sv_d, rho_in, ex_out, ec_out, vx_out, vc_out ) ! REAL(DP), ALLOCATABLE :: arho(:), zeta(:) ! - INTEGER :: ir + INTEGER :: ir, iexch, icorr ! + iexch = get_iexch() + icorr = get_icorr() ! #if defined(__LIBXC) ! - IF (SUM(libxc_switches_lda) /= 0) THEN + IF ( ANY(is_libxc(1:2)) ) THEN ! ALLOCATE( rho_lxc(length*sv_d) ) ALLOCATE( vx_lxc(length*sv_d), vc_lxc(length*sv_d) ) @@ -180,21 +133,21 @@ SUBROUTINE xc( length, sr_d, sv_d, rho_in, ex_out, ec_out, vx_out, vc_out ) ! ! ! ... EXCHANGE - IF ( libxc_switches_lda(1)==1 ) THEN - CALL xc_f90_func_init( xc_func, xc_info1, iexch_l, sv_d ) + IF ( is_libxc(1) ) THEN + CALL xc_f90_func_init( xc_func, xc_info1, iexch, sv_d ) fkind_x = xc_f90_info_kind( xc_info1 ) CALL xc_f90_lda_exc_vxc( xc_func, length, rho_lxc(1), ex_out(1), vx_lxc(1) ) CALL xc_f90_func_end( xc_func ) ENDIF ! ! ... CORRELATION - IF ( libxc_switches_lda(2)==1 ) THEN - CALL xc_f90_func_init( xc_func, xc_info2, icorr_l, sv_d ) + IF ( is_libxc(2) ) THEN + CALL xc_f90_func_init( xc_func, xc_info2, icorr, sv_d ) CALL xc_f90_lda_exc_vxc( xc_func, length, rho_lxc(1), ec_out(1), vc_lxc(1) ) CALL xc_f90_func_end( xc_func ) ENDIF ! - IF ( ((libxc_switches_lda(1)==0) .OR. (libxc_switches_lda(2)==0)) & + IF ( ((.NOT.is_libxc(1)) .OR. (.NOT.is_libxc(2))) & .AND. fkind_x/=XC_EXCHANGE_CORRELATION ) THEN ! SELECT CASE( sr_d ) @@ -230,16 +183,16 @@ SUBROUTINE xc( length, sr_d, sv_d, rho_in, ex_out, ec_out, vx_out, vc_out ) ! ... fill output arrays ! IF (sv_d == 1) THEN - IF (libxc_switches_lda(1)==1) vx_out(:,1) = vx_lxc(:) - IF (libxc_switches_lda(2)==1) vc_out(:,1) = vc_lxc(:) + IF (is_libxc(1)) vx_out(:,1) = vx_lxc(:) + IF (is_libxc(2)) vc_out(:,1) = vc_lxc(:) ELSE - IF (libxc_switches_lda(1)==1) THEN + IF (is_libxc(1)) THEN DO ir = 1, length vx_out(ir,1) = vx_lxc(2*ir-1) vx_out(ir,2) = vx_lxc(2*ir) ENDDO ENDIF - IF (libxc_switches_lda(2)==1) THEN + IF (is_libxc(2)) THEN DO ir = 1, length vc_out(ir,1) = vc_lxc(2*ir-1) vc_out(ir,2) = vc_lxc(2*ir) @@ -247,7 +200,7 @@ SUBROUTINE xc( length, sr_d, sv_d, rho_in, ex_out, ec_out, vx_out, vc_out ) ENDIF ENDIF ! - IF (SUM(libxc_switches_lda) /= 0) THEN + IF (ANY(is_libxc(1:2))) THEN DEALLOCATE( rho_lxc ) DEALLOCATE( vx_lxc, vc_lxc ) ENDIF @@ -340,10 +293,13 @@ SUBROUTINE xc_lda( length, rho_in, ex_out, ec_out, vx_out, vc_out ) ! ! ... local variables ! - INTEGER :: ir + INTEGER :: ir, iexch, icorr REAL(DP) :: rho, rs REAL(DP) :: ex, ec, ec_ REAL(DP) :: vx, vc, vc_ + REAL(DP) :: exx_fraction + REAL(DP) :: finite_size_cell_volume + LOGICAL :: exx_started, is_there_finite_size_corr REAL(DP), PARAMETER :: third = 1.0_DP/3.0_DP, & pi34 = 0.6203504908994_DP, e2 = 2.0_DP ! pi34 = (3/4pi)^(1/3) @@ -355,8 +311,20 @@ SUBROUTINE xc_lda( length, rho_in, ex_out, ec_out, vx_out, vc_out ) ntids = omp_get_num_threads() #endif ! + iexch = get_iexch() + icorr = get_icorr() + exx_started = exx_is_active() + exx_fraction = get_exx_fraction() + IF (iexch==8 .OR. icorr==10) THEN + CALL get_finite_size_cell_volume( is_there_finite_size_corr, & + finite_size_cell_volume ) + ! + IF (.NOT. is_there_finite_size_corr) CALL errore( 'XC',& + 'finite size corrected exchange used w/o initialization', 1 ) + ENDIF + ! !$omp parallel if(ntids==1) -!$omp do private( rho, rs, ex, ec, ec_, vx, vc, vc_ ) +!$omp do private( rho, rs, ex, ec, ec_, vx, vc, vc_, exx_fraction ) DO ir = 1, length ! rho = ABS(rho_in(ir)) @@ -373,7 +341,7 @@ SUBROUTINE xc_lda( length, rho_in, ex_out, ec_out, vx_out, vc_out ) ! ! ... EXCHANGE ! - SELECT CASE( iexch_l ) + SELECT CASE( iexch ) CASE( 1 ) ! 'sla' ! CALL slater( rs, ex, vx ) @@ -388,7 +356,7 @@ SUBROUTINE xc_lda( length, rho_in, ex_out, ec_out, vx_out, vc_out ) ! CASE( 4, 5 ) ! 'oep','hf' ! - IF ( exx_started_l ) THEN + IF ( exx_started ) THEN ex = 0.0_DP vx = 0.0_DP ELSE @@ -398,23 +366,21 @@ SUBROUTINE xc_lda( length, rho_in, ex_out, ec_out, vx_out, vc_out ) CASE( 6, 7 ) ! 'pb0x' or 'DF-cx-0', or 'DF2-0', ! ! 'B3LYP' CALL slater( rs, ex, vx ) - IF ( exx_started_l ) THEN - ex = (1.0_DP - exx_fraction_l) * ex - vx = (1.0_DP - exx_fraction_l) * vx + IF ( exx_started ) THEN + ex = (1.0_DP - exx_fraction) * ex + vx = (1.0_DP - exx_fraction) * vx ENDIF ! CASE( 8 ) ! 'sla+kzk' ! - IF (.NOT. is_there_finite_size_corr) CALL errore( 'XC',& - 'finite size corrected exchange used w/o initialization', 2 ) - CALL slaterKZK( rs, ex, vx, finite_size_cell_volume_l ) + CALL slaterKZK( rs, ex, vx, finite_size_cell_volume ) ! CASE( 9 ) ! 'X3LYP' ! CALL slater( rs, ex, vx ) - IF ( exx_started_l ) THEN - ex = (1.0_DP - exx_fraction_l) * ex - vx = (1.0_DP - exx_fraction_l) * vx + IF ( exx_started ) THEN + ex = (1.0_DP - exx_fraction) * ex + vx = (1.0_DP - exx_fraction) * vx ENDIF ! CASE DEFAULT @@ -427,7 +393,7 @@ SUBROUTINE xc_lda( length, rho_in, ex_out, ec_out, vx_out, vc_out ) ! ! ... CORRELATION ! - SELECT CASE( icorr_l ) + SELECT CASE( icorr ) CASE( 1 ) ! CALL pz( rs, 1, ec, vc ) @@ -466,9 +432,7 @@ SUBROUTINE xc_lda( length, rho_in, ex_out, ec_out, vx_out, vc_out ) ! CASE( 10 ) ! - IF (.NOT. is_there_finite_size_corr) CALL errore( 'XC',& - 'finite size corrected exchange used w/o initialization', 3 ) - CALL pzKZK( rs, ec, vc, finite_size_cell_volume_l ) + CALL pzKZK( rs, ec, vc, finite_size_cell_volume ) ! CASE( 11 ) ! @@ -554,10 +518,12 @@ SUBROUTINE xc_lsda( length, rho_in, zeta_in, ex_out, ec_out, vx_out, vc_out ) ! ! ... local variables ! - INTEGER :: ir + INTEGER :: ir, iexch, icorr REAL(DP) :: rho, rs, zeta REAL(DP) :: ex, ec, ec_ REAL(DP) :: vx(2), vc(2), vc_(2) + REAL(DP) :: exx_fraction + LOGICAL :: exx_started ! REAL(DP), PARAMETER :: third = 1.0_DP/3.0_DP, & pi34 = 0.6203504908994_DP @@ -570,8 +536,13 @@ SUBROUTINE xc_lsda( length, rho_in, zeta_in, ex_out, ec_out, vx_out, vc_out ) ntids = omp_get_num_threads() #endif ! + iexch = get_iexch() + icorr = get_icorr() + exx_started = exx_is_active() + exx_fraction = get_exx_fraction() + ! !$omp parallel if(ntids==1) -!$omp do private( rho, rs, zeta, ex, ec, ec_, vx, vc, vc_ ) +!$omp do private( rho, rs, zeta, ex, ec, ec_, vx, vc, vc_, exx_fraction ) DO ir = 1, length ! zeta = zeta_in(ir) @@ -590,7 +561,7 @@ SUBROUTINE xc_lsda( length, rho_in, zeta_in, ex_out, ec_out, vx_out, vc_out ) ! ! ... EXCHANGE ! - SELECT CASE( iexch_l ) + SELECT CASE( iexch ) CASE( 1 ) ! 'sla' ! CALL slater_spin( rho, zeta, ex, vx ) @@ -605,7 +576,7 @@ SUBROUTINE xc_lsda( length, rho_in, zeta_in, ex_out, ec_out, vx_out, vc_out ) ! CASE( 4, 5 ) ! 'oep','hf' ! - IF ( exx_started_l ) THEN + IF ( exx_started ) THEN ex = 0.0_DP vx = 0.0_DP ELSE @@ -615,25 +586,25 @@ SUBROUTINE xc_lsda( length, rho_in, zeta_in, ex_out, ec_out, vx_out, vc_out ) CASE( 6 ) ! 'pb0x' ! CALL slater_spin( rho, zeta, ex, vx ) - IF ( exx_started_l ) THEN - ex = (1.0_DP - exx_fraction_l) * ex - vx = (1.0_DP - exx_fraction_l) * vx + IF ( exx_started ) THEN + ex = (1.0_DP - exx_fraction) * ex + vx = (1.0_DP - exx_fraction) * vx ENDIF ! CASE( 7 ) ! 'B3LYP' ! CALL slater_spin( rho, zeta, ex, vx ) - IF ( exx_started_l ) THEN - ex = (1.0_DP - exx_fraction_l) * ex - vx = (1.0_DP - exx_fraction_l) * vx + IF ( exx_started ) THEN + ex = (1.0_DP - exx_fraction) * ex + vx = (1.0_DP - exx_fraction) * vx ENDIF ! CASE( 9 ) ! 'X3LYP' ! CALL slater_spin( rho, zeta, ex, vx ) - IF ( exx_started_l ) THEN - ex = (1.0_DP - exx_fraction_l) * ex - vx = (1.0_DP - exx_fraction_l) * vx + IF ( exx_started ) THEN + ex = (1.0_DP - exx_fraction) * ex + vx = (1.0_DP - exx_fraction) * vx ENDIF ! CASE DEFAULT @@ -646,7 +617,7 @@ SUBROUTINE xc_lsda( length, rho_in, zeta_in, ex_out, ec_out, vx_out, vc_out ) ! ! ... CORRELATION ! - SELECT CASE( icorr_l ) + SELECT CASE( icorr ) CASE( 0 ) ! ec = 0.0_DP @@ -700,7 +671,7 @@ SUBROUTINE xc_lsda( length, rho_in, zeta_in, ex_out, ec_out, vx_out, vc_out ) ! CASE DEFAULT ! - CALL errore( 'xc_lda_lsda_drivers (xc_lsda)', 'not implemented', icorr_l ) + CALL errore( 'xc_lda_lsda_drivers (xc_lsda)', 'not implemented', icorr ) ! END SELECT ! diff --git a/Modules/xc_mgga_drivers.f90 b/Modules/xc_mgga_drivers.f90 index 2369dfcddc..a16e716236 100644 --- a/Modules/xc_mgga_drivers.f90 +++ b/Modules/xc_mgga_drivers.f90 @@ -1,6 +1,7 @@ MODULE xc_mgga ! -USE kinds, ONLY: DP +USE kinds, ONLY: DP +USE funct, ONLY: get_meta, get_metac, is_libxc ! IMPLICIT NONE ! @@ -10,58 +11,16 @@ MODULE xc_mgga ! GGA exchange-correlation drivers PUBLIC :: xc_metagcx PUBLIC :: tau_xc, tau_xc_spin -PUBLIC :: change_threshold_mgga, select_mgga_functionals +PUBLIC :: change_threshold_mgga ! -PUBLIC :: libxc_switches_mgga -PUBLIC :: imeta_l, imetac_l -PUBLIC :: exx_started_mg, exx_fraction_mg -! -! libxc on/off -INTEGER :: libxc_switches_mgga(2) -! -! indexes defining xc functionals -INTEGER :: imeta_l, imetac_l ! ! input thresholds (default values) REAL(DP) :: rho_threshold = 1.0E-8_DP REAL(DP) :: grho2_threshold = 1.0E-12_DP REAL(DP) :: tau_threshold = 1.0E-8_DP ! -! variables for hybrid exchange -LOGICAL :: exx_started_mg -REAL(DP) :: exx_fraction_mg -! -! - CONTAINS -! -! -!---------------------------------------------------------------------------- -!----- Select functionals by the corresponding indexes ---------------------- -!---------------------------------------------------------------------------- -SUBROUTINE select_mgga_functionals( imeta, imetac, exx_fraction ) - !----------------------------------------------------------------------------- - ! - IMPLICIT NONE - ! - INTEGER, INTENT(IN) :: imeta, imetac - REAL(DP), INTENT(IN), OPTIONAL :: exx_fraction - ! - ! exchange-correlation indexes - imeta_l = imeta - imetac_l = imetac - ! - ! hybrid exchange vars - exx_started_mg = .FALSE. - exx_fraction_mg = 0._DP - IF ( PRESENT(exx_fraction) ) THEN - exx_started_mg = .TRUE. - exx_fraction_mg = exx_fraction - ENDIF - ! - RETURN - ! -END SUBROUTINE select_mgga_functionals ! + CONTAINS ! ! !------------------------------------------------------------------------------------- @@ -82,7 +41,6 @@ SUBROUTINE change_threshold_mgga( rho_thr_in, grho2_thr_in, tau_thr_in ) END SUBROUTINE change_threshold_mgga ! ! -! !---------------------------------------------------------------------------------------- SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c ) !------------------------------------------------------------------------------------- @@ -127,7 +85,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 ! ! ... local variables ! - INTEGER :: is + INTEGER :: is, imeta, imetac REAL(DP), ALLOCATABLE :: grho2(:,:) ! #if defined(__LIBXC) @@ -143,6 +101,9 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 INTEGER :: k, ipol, pol_unpol LOGICAL :: POLARIZED ! + imeta = get_meta() + imetac = get_metac() + ! POLARIZED = .FALSE. IF (ns == 2) THEN POLARIZED = .TRUE. @@ -185,7 +146,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 ! ENDIF ! - IF (SUM(libxc_switches_mgga(:)) /= 2) THEN + IF ( ANY(.NOT.is_libxc(5:6)) ) THEN ! ALLOCATE( grho2(length,ns) ) ! @@ -207,8 +168,8 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 ! ! META EXCHANGE ! - IF (libxc_switches_mgga(1) == 1) THEN - CALL xc_f90_func_init( xc_func, xc_info1, imeta_l, pol_unpol ) + IF ( is_libxc(5) ) THEN + CALL xc_f90_func_init( xc_func, xc_info1, imeta, pol_unpol ) CALL xc_f90_mgga_exc_vxc( xc_func, length, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), & ex_lxc(1), vx_rho(1), vx_sigma(1), vlapl_rho(1), vx_tau(1) ) CALL xc_f90_func_end( xc_func ) @@ -236,9 +197,9 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 ! ! META CORRELATION ! - IF ( libxc_switches_mgga(2) == 1 ) THEN + IF ( is_libxc(6) ) THEN ! - CALL xc_f90_func_init( xc_func, xc_info1, imetac_l, pol_unpol ) + CALL xc_f90_func_init( xc_func, xc_info1, imetac, pol_unpol ) CALL xc_f90_mgga_exc_vxc( xc_func, length, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), & ec_lxc(1), vc_rho(1), vc_sigma(1), vlapl_rho(1), vc_tau(1) ) CALL xc_f90_func_end( xc_func ) @@ -321,11 +282,13 @@ SUBROUTINE tau_xc( length, rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c ! INTEGER, INTENT(IN) :: length ! - INTEGER :: k + INTEGER :: k, imeta REAL(DP) :: arho REAL(DP), DIMENSION(length) :: rho, grho2, tau, & ex, ec, v1x, v2x, v3x, v1c, v2c, v3c ! + imeta = get_meta() + ! v1x=0.d0 ; v2x=0.d0 ; v3x=0.d0 ; ex=0.d0 v1c=0.d0 ; v2c=0.d0 ; v3c=0.d0 ; ec=0.d0 ! @@ -335,7 +298,7 @@ SUBROUTINE tau_xc( length, rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, v3c ! IF ( (arho<=rho_threshold).OR.(grho2(k)<=grho2_threshold).OR.(ABS(tau(k))<=rho_threshold) ) CYCLE ! - SELECT CASE( imeta_l ) + SELECT CASE( imeta ) CASE( 1 ) CALL tpsscxc( arho, grho2(k), tau(k), ex(k), ec(k), v1x(k), v2x(k), v3x(k), v1c(k), v2c(k), v3c(k) ) CASE( 2 ) @@ -369,9 +332,11 @@ SUBROUTINE tau_xc_spin( length, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, ! ! ... local variables ! - INTEGER :: k, ipol + INTEGER :: k, ipol, imeta REAL(DP) :: rh, zeta, atau, grho2(2), ggrho2 ! + imeta = get_meta() + ! ex=0.0_DP ; v1x=0.0_DP ; v2x=0.0_DP ; v3x=0.0_DP ec=0.0_DP ; v1c=0.0_DP ; v2c=0.0_DP ; v3c=0.0_DP ! @@ -387,7 +352,7 @@ SUBROUTINE tau_xc_spin( length, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, ! IF ((rh <= rho_threshold) .OR. (ggrho2 <= grho2_threshold) .OR. (ABS(atau) <= tau_threshold)) CYCLE ! - SELECT CASE( imeta_l ) + SELECT CASE( imeta ) CASE( 1 ) ! CALL tpsscx_spin( rho(k,1), rho(k,2), grho2(1), grho2(2), tau(k,1), & @@ -406,7 +371,7 @@ SUBROUTINE tau_xc_spin( length, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, ! CASE DEFAULT ! - CALL errore( 'tau_xc_spin', 'This case not implemented', imeta_l ) + CALL errore( 'tau_xc_spin', 'This case not implemented', imeta ) ! END SELECT ! diff --git a/PP/src/benchmark_libxc.f90 b/PP/src/benchmark_libxc.f90 index 96366325ef..21b13e856f 100644 --- a/PP/src/benchmark_libxc.f90 +++ b/PP/src/benchmark_libxc.f90 @@ -11,11 +11,11 @@ PROGRAM benchmark_libxc !! This program compares the output results (energies and potentials) from the libxc !! routines with the ones from q-e xc internal library. !! Available options: - !! * full LDA ; + !! * LDA ; !! * derivative of LDA pot. (dmxc) ; - !! * full GGA ; + !! * GGA ; !! * derivative of GGA pot. (dgcxc, the polarized case is not yet complete) ; - !! * full metaGGA . + !! * metaGGA. ! !------------------------------------------------------------------------------------! ! To be run on a single processor @@ -26,9 +26,10 @@ PROGRAM benchmark_libxc USE xc_f90_types_m USE xc_f90_lib_m ! - USE xc_lda_lsda - USE xc_gga - USE xc_mgga + USE funct, ONLY: set_dft_from_indices, set_exx_fraction + USE xc_lda_lsda, ONLY: xc_lda, xc_lsda + USE xc_gga, ONLY: gcxc, gcx_spin, gcc_spin, gcc_spin_more + USE xc_mgga, ONLY: tau_xc, tau_xc_spin ! IMPLICIT NONE ! @@ -392,7 +393,14 @@ PROGRAM benchmark_libxc ! !----- QE ---------- ! - CALL select_lda_functionals( iexch_qe, icorr_qe ) ! ... EXCHANGE and CORRELATION + CALL set_dft_from_indices( iexch_qe, icorr_qe, 0, 0, 0, 0 ) ! ... EXCHANGE and CORRELATION + ! + ! get exx_fraction, if needed + CALL xc_f90_func_init( xc_func, xc_info1, iexch_qe, 1 ) + family = xc_f90_info_family( xc_info1 ) + IF (family == XC_FAMILY_HYB_GGA) CALL xc_f90_hyb_exx_coef( xc_func, exx_frctn ) + CALL xc_f90_func_end( xc_func ) + CALL set_exx_fraction( exx_frctn ) ! IF ( DF_OK ) THEN IF ( .NOT.POLARIZED ) THEN @@ -491,7 +499,10 @@ PROGRAM benchmark_libxc ! !----- QE ---------- ! - CALL select_gga_functionals( iexch_qe, icorr_qe, exx_fraction=exx_frctn ) + CALL set_dft_from_indices( 0, 0, iexch_qe, icorr_qe, 0, 0 ) ! ... EXCHANGE and CORRELATION + ! + ! get exx_fraction, if needed + CALL set_exx_fraction( exx_frctn ) ! IF ( DF_OK ) THEN ! @@ -505,7 +516,7 @@ PROGRAM benchmark_libxc ENDIF ! ELSE - ! + ! IF ( .NOT. POLARIZED ) THEN ! CALL gcxc( nnr, rho_qe(:,1), grho2(:,1), ex_qe, ec_qe, v1x(:,1), v2x(:,1), v1c(:,1), v2c(:,1) ) @@ -581,7 +592,10 @@ PROGRAM benchmark_libxc ! !----- QE ---------- ! - CALL select_mgga_functionals( iexch_qe, icorr_qe ) ! ... icorr_qe not used + !CALL select_mgga_functionals( iexch_qe, icorr_qe ) ! ... icorr_qe not used + ! + ! + CALL set_dft_from_indices( 0, 0, 0, 0, iexch_qe, 0 ) ! ... EXCHANGE and CORRELATION ! IF ( .NOT. POLARIZED ) THEN CALL tau_xc( nnr, rho_qe(:,1), grho2(:,1), tau_qe(:,1), ex_qe, ec_qe, v1x(:,1), & diff --git a/PP/src/vasp_xml_module.f90 b/PP/src/vasp_xml_module.f90 index 21af5d90b5..4b1b318d80 100644 --- a/PP/src/vasp_xml_module.f90 +++ b/PP/src/vasp_xml_module.f90 @@ -180,7 +180,7 @@ SUBROUTINE readxmlfile_vasp(iexch,icorr,igcx,igcc,inlc,ierr) vasp_atominfo_obj, vasp_structure_obj) CALL errore( 'read_xml_file ', 'problem reading file ' // TRIM( tmp_dir ) //'vasprun.xml', ierr ) ! - CALL set_dft_from_indices(iexch, icorr, igcx, igcc, inlc) + CALL set_dft_from_indices(iexch, icorr, igcx, igcc, 0, inlc) WRITE( stdout, '(5X,"Exchange-correlation = ", & & " (",I2,3I3,2I2,")")') iexch,icorr,igcx,igcc,inlc,imeta ! diff --git a/PP/src/xctest.f90 b/PP/src/xctest.f90 index 61d2992076..87d967de77 100644 --- a/PP/src/xctest.f90 +++ b/PP/src/xctest.f90 @@ -26,7 +26,7 @@ PROGRAM xctest igcx=1 igcc=3 inlc=0 - CALL set_dft_from_indices(iexch,icorr,igcx,igcc,inlc) + CALL set_dft_from_indices(iexch,icorr,igcx,igcc,0,inlc) OPEN(unit=17,form='unformatted',status='old') READ(17) nnr, nspin diff --git a/PW/src/paw_onecenter.f90 b/PW/src/paw_onecenter.f90 index 56c5e49c81..8ff8af2ea5 100644 --- a/PW/src/paw_onecenter.f90 +++ b/PW/src/paw_onecenter.f90 @@ -1692,7 +1692,8 @@ SUBROUTINE PAW_dgcxc_potential(i,rho_lm,rho_core, drho_lm, v_lm) USE lsda_mod, ONLY : nspin USE atom, ONLY : g => rgrid USE constants, ONLY : pi,e2, eps => eps12, eps2 => eps24 - USE xc_gga, ONLY : gcxc, gcx_spin, gcc_spin, libxc_switches_gga + USE funct, ONLY : is_libxc + USE xc_gga, ONLY : gcxc, gcx_spin, gcc_spin ! TYPE(paw_info), INTENT(IN) :: i ! atom's minimal info REAL(DP), INTENT(IN) :: rho_lm(i%m,i%l**2,nspin_mag) ! charge density as lm components @@ -1739,7 +1740,7 @@ SUBROUTINE PAW_dgcxc_potential(i,rho_lm,rho_core, drho_lm, v_lm) ! IF (TIMING) CALL start_clock( 'PAW_dgcxc_v' ) ! - IF ( SUM(libxc_switches_gga(:)) /= 0 ) CALL errore( 'PAW_dgcxc_potential', 'libxc derivatives of & + IF ( ANY(is_libxc(3:4)) ) CALL errore( 'PAW_dgcxc_potential', 'libxc derivatives of & &xc potentials for GGA not available yet', 1 ) ! zero = 0.0_DP diff --git a/atomic/src/read_pseudo_rrkj3.f90 b/atomic/src/read_pseudo_rrkj3.f90 index 75af81f622..db88a3fa39 100644 --- a/atomic/src/read_pseudo_rrkj3.f90 +++ b/atomic/src/read_pseudo_rrkj3.f90 @@ -56,7 +56,7 @@ subroutine read_pseudo_rrkj3 (ios) & 'non relativistic pseudopotential and relativistic calculation',-1) read( iunps, '(4i5)',err=100, iostat=ios ) iexch, icorr, igcx, igcc - call set_dft_from_indices(iexch, icorr, igcx, igcc, 0) + call set_dft_from_indices(iexch, icorr, igcx, igcc, 0, 0) read( iunps, '(2e17.11,i5)') zval, etots, lmax From d0004bc8c223ac7a8105d26ffa83daf6a2bc3104 Mon Sep 17 00:00:00 2001 From: Samuel Ponce Date: Tue, 25 Jun 2019 15:41:34 +0100 Subject: [PATCH 26/95] Modification to support Python 2 and 3. --- EPW/bin/{pp-xml.py => pp-xml-depreciated.py} | 0 EPW/bin/pp.py | 13 +++++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) rename EPW/bin/{pp-xml.py => pp-xml-depreciated.py} (100%) diff --git a/EPW/bin/pp-xml.py b/EPW/bin/pp-xml-depreciated.py similarity index 100% rename from EPW/bin/pp-xml.py rename to EPW/bin/pp-xml-depreciated.py diff --git a/EPW/bin/pp.py b/EPW/bin/pp.py index f35253c5ee..af672721b9 100644 --- a/EPW/bin/pp.py +++ b/EPW/bin/pp.py @@ -6,7 +6,13 @@ # 14/03/2018 - Detect if SOC is included in the calculation - Samuel Ponce # 05/06/2019 - Removed SOC for xml detection instead - Felix Goudreault # -import numpy as np +from __future__ import print_function +try: + from builtins import input +except ImportError: + print('Install future. e.g. "pip install --user future"') +# import numpy as np + import os from xml.dom import minidom @@ -53,6 +59,9 @@ def hasXML(prefix): # check if the other without .xml extension exists # if not raise an error fname_no_xml = fname.strip(".xml") + + class FileNotFoundError(Exception): + pass if not os.path.isfile(fname_no_xml): raise FileNotFoundError( "No dyn0 file found cannot tell if xml format was used.") @@ -98,7 +107,7 @@ def isSEQ(prefix): os.system('mkdir save 2>/dev/null') -for iqpt in np.arange(1, nqpt+1): +for iqpt in range(1, nqpt+1): label = str(iqpt) # Case calculation in seq. From 91c8ec1c4fae83f77bfcc12310a37028f5a5ca8e Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Tue, 25 Jun 2019 18:14:49 +0200 Subject: [PATCH 27/95] some minor adjustments --- Modules/dmxc_drivers.f90 | 68 ++++++++++++++++--------------------- Modules/funct.f90 | 6 ++-- Modules/xc_mgga_drivers.f90 | 15 +++++++- 3 files changed, 47 insertions(+), 42 deletions(-) diff --git a/Modules/dmxc_drivers.f90 b/Modules/dmxc_drivers.f90 index 93791d64fa..6bbcf0e34b 100644 --- a/Modules/dmxc_drivers.f90 +++ b/Modules/dmxc_drivers.f90 @@ -304,7 +304,6 @@ SUBROUTINE dmxc_lsda( length, rho_in, dmuxc ) ! ... local variables ! REAL(DP), DIMENSION(length) :: rhotot, zeta, zeta_eff - REAL(DP), DIMENSION(length) :: null_v ! REAL(DP), ALLOCATABLE, DIMENSION(:) :: aux1, aux2, dr, dz REAL(DP), ALLOCATABLE, DIMENSION(:) :: rhoaux, zetaux @@ -325,14 +324,12 @@ SUBROUTINE dmxc_lsda( length, rho_in, dmuxc ) REAL(DP), PARAMETER :: small = 1.E-30_DP, e2 = 2.0_DP, & pi34 = 0.75_DP/3.141592653589793_DP, & third = 1.0_DP/3.0_DP, p43 = 4.0_DP/3.0_DP, & - p49 = 4.0_DP/9.0_DP, m23 = -2.0_DP/3.0_DP, & - rho_trash = 0.5_DP, zeta_trash = 0.5_DP + p49 = 4.0_DP/9.0_DP, m23 = -2.0_DP/3.0_DP ! iexch = get_iexch() icorr = get_icorr() ! - dmuxc = 0.0_DP - null_v = 1.0_DP + dmuxc = 0.0_DP rhotot(:) = rho_in(:,1) + rho_in(:,2) ! IF (iexch == 1 .AND. icorr == 1) THEN @@ -408,39 +405,38 @@ SUBROUTINE dmxc_lsda( length, rho_in, dmuxc ) ! dz(:) = 1.E-6_DP ! dz(:) = MIN( 1.d-6, 1.d-4*ABS(zeta(:)) ) ! - ! ... THRESHOLD STUFF + ! ... THRESHOLD STUFF AND dr(:) + dr(:) = 0.0_DP DO ir = 1, length - zeta_s=zeta_trash - IF (rhotot(ir) <= small) THEN - rhotot(ir)=rho_trash ; null_v(ir) = 0.0_DP + IF (rhotot(ir) > small) THEN + zeta_s = (rho_in(ir,1) - rho_in(ir,2)) / rhotot(ir) + zeta(ir) = zeta_s + ! ... If zeta is too close to +-1, the derivative is computed at a slightly + ! smaller zeta + zeta_eff(ir) = SIGN( MIN( ABS(zeta_s), (1.0_DP-2.0_DP*dz(ir)) ), zeta_s ) + dr(ir) = MIN( 1.E-6_DP, 1.E-4_DP * rhotot(ir) ) ENDIF - IF (rhotot(ir) > small) zeta_s = (rho_in(ir,1) - rho_in(ir,2)) / rhotot(ir) - zeta(ir) = zeta_s - ! ... If zeta is too close to +-1, the derivative is computed at a slightly - ! smaller zeta - zeta_eff(ir) = SIGN( MIN( ABS(zeta_s), (1.0_DP-2.0_DP*dz(ir)) ), zeta_s ) - IF (ABS(zeta_s) > 1.0_DP) null_v(ir) = 0.0_DP ENDDO ! - dr(:) = MIN( 1.E-6_DP, 1.E-4_DP * rhotot(:) ) - ! rhoaux(i1:f1) = rhotot + dr ; zetaux(i1:f1) = zeta rhoaux(i2:f2) = rhotot - dr ; zetaux(i2:f2) = zeta rhoaux(i3:f3) = rhotot ; zetaux(i3:f3) = zeta_eff + dz rhoaux(i4:f4) = rhotot ; zetaux(i4:f4) = zeta_eff - dz ! - ! CALL xc_lsda( length*4, rhoaux, zetaux, aux1, aux2, vx, vc ) ! + WHERE (rhotot <= small) ! ... to avoid NaN in the next operations + dr=1.0_DP ; rhotot=0.5d0 + END WHERE ! dmuxc(:,1,1) = ( vx(i1:f1,1) + vc(i1:f1,1) - vx(i2:f2,1) - vc(i2:f2,1) ) / (2.0_DP*dr) dmuxc(:,2,2) = ( vx(i1:f1,2) + vc(i1:f1,2) - vx(i2:f2,2) - vc(i2:f2,2) ) / (2.0_DP*dr) ! aux1(i1:f1) = 1.0_DP / rhotot(:) / (2.0_DP*dz(:)) aux1(i2:f2) = aux1(i1:f1) - DO is = 1, 2 - vxc(i1:f2,is) = ( vx(i3:f4,is) + vc(i3:f4,is) ) * aux1(i1:f2) - ENDDO + ! + vxc(i1:f2,1) = ( vx(i3:f4,1) + vc(i3:f4,1) ) * aux1(i1:f2) + vxc(i1:f2,2) = ( vx(i3:f4,2) + vc(i3:f4,2) ) * aux1(i1:f2) ! dmuxc(:,2,1) = dmuxc(:,1,1) - (vxc(i1:f1,1) - vxc(i2:f2,1)) * (1.0_DP+zeta) dmuxc(:,1,2) = dmuxc(:,2,2) + (vxc(i1:f1,2) - vxc(i2:f2,2)) * (1.0_DP-zeta) @@ -454,12 +450,9 @@ SUBROUTINE dmxc_lsda( length, rho_in, dmuxc ) ! ENDIF ! - ! ... bring to rydberg units and set to zero trash points + ! ... bring to Rydberg units ! - dmuxc(:,1,1) = e2 * dmuxc(:,1,1) * null_v !up-up - dmuxc(:,2,1) = e2 * dmuxc(:,2,1) * null_v !down-up - dmuxc(:,1,2) = e2 * dmuxc(:,1,2) * null_v !up-down - dmuxc(:,2,2) = e2 * dmuxc(:,2,2) * null_v !down-down + dmuxc = e2 * dmuxc ! RETURN ! @@ -488,10 +481,10 @@ SUBROUTINE dmxc_nc( length, rho_in, m, dmuxc ) ! ! ... local variables ! - REAL(DP), DIMENSION(length) :: rhotot, amag, zeta, zeta_eff, dr, dz - REAL(DP), ALLOCATABLE, DIMENSION(:) :: rhoaux, zetaux + REAL(DP), DIMENSION(length) :: rhotot, amag, zeta, zeta_eff, dr, dz REAL(DP), DIMENSION(length) :: vs - INTEGER, DIMENSION(length) :: null_v + LOGICAL, DIMENSION(length) :: is_null + REAL(DP), ALLOCATABLE, DIMENSION(:) :: rhoaux, zetaux REAL(DP), ALLOCATABLE, DIMENSION(:) :: aux1, aux2 REAL(DP), ALLOCATABLE, DIMENSION(:,:) :: vx, vc REAL(DP), DIMENSION(length) :: dvxc_rho, dbx_rho, dby_rho, dbz_rho @@ -500,7 +493,7 @@ SUBROUTINE dmxc_nc( length, rho_in, m, dmuxc ) dbx_mx, dbx_my, dbx_mz, & dby_mx, dby_my, dby_mz, & dbz_mx, dbz_my, dbz_mz - REAL(DP) :: rnull, zeta_s + REAL(DP) :: zeta_s ! INTEGER :: i1, i2, i3, i4, i5, i INTEGER :: f1, f2, f3, f4, f5 @@ -518,7 +511,7 @@ SUBROUTINE dmxc_nc( length, rho_in, m, dmuxc ) rhotot = rho_in zeta = zeta_trash amag = amag_trash - null_v = 1 + is_null = .FALSE. ! i1 = 1 ; f1 = length ! five blocks: [ rho , zeta ] i2 = f1+1 ; f2 = 2*length ! [ rho+dr , zeta ] @@ -531,17 +524,18 @@ SUBROUTINE dmxc_nc( length, rho_in, m, dmuxc ) DO i = 1, length zeta_s = zeta_trash IF (rhotot(i) <= small) THEN - rhotot(i) = rho_trash ; null_v(i) = 0.0_DP + rhotot(i) = rho_trash + is_null(i) = .TRUE. ENDIF amag(i) = SQRT( m(i,1)**2 + m(i,2)**2 + m(i,3)**2 ) IF (rhotot(i) > small) zeta_s = amag(i) / rhotot(i) zeta(i) = zeta_s zeta_eff(i) = SIGN( MIN( ABS(zeta_s), (1.0_DP-2.0_DP*dz(i)) ), zeta_s ) - IF (ABS(zeta_s) > 1.0_DP) null_v(i) = 0 + IF (ABS(zeta_s) > 1.0_DP) is_null(i) = .TRUE. ENDDO ! dr = MIN( 1.E-6_DP, 1.E-4_DP * rhotot ) - ! + ! rhoaux(i1:f1) = rhotot ; zetaux(i1:f1) = zeta rhoaux(i2:f2) = rhotot + dr ; zetaux(i2:f2) = zeta rhoaux(i3:f3) = rhotot - dr ; zetaux(i3:f3) = zeta @@ -556,7 +550,7 @@ SUBROUTINE dmxc_nc( length, rho_in, m, dmuxc ) ! dvxc_rho(:) = ((vx(i2:f2,1) + vc(i2:f2,1) - vx(i3:f3,1) - vc(i3:f3,1)) + & (vx(i2:f2,2) + vc(i2:f2,2) - vx(i3:f3,2) - vc(i3:f3,2))) / (4.0_DP*dr) - ! + ! aux2(1:length) = vx(i2:f2,1) + vc(i2:f2,1) - vx(i3:f3,1) - vc(i3:f3,1) - & ( vx(i2:f2,2) + vc(i2:f2,2) - vx(i3:f3,2) - vc(i3:f3,2) ) ! @@ -571,7 +565,7 @@ SUBROUTINE dmxc_nc( length, rho_in, m, dmuxc ) ! DO i = 1, length ! - IF ( null_v(i) == 0 ) THEN + IF ( is_null(i) ) THEN dmuxc(i,:,:) = 0.0_DP CYCLE ENDIF @@ -593,8 +587,6 @@ SUBROUTINE dmxc_nc( length, rho_in, m, dmuxc ) ! ! ... Here the derivatives with respect to m ! - rnull = null_v(i) - ! dvxc_mx = aux1(i) * m(i,1) / rhotot(i) / (4.0_DP*dz(i)*amag(i)) dvxc_my = aux1(i) * m(i,2) / rhotot(i) / (4.0_DP*dz(i)*amag(i)) dvxc_mz = aux1(i) * m(i,3) / rhotot(i) / (4.0_DP*dz(i)*amag(i)) diff --git a/Modules/funct.f90 b/Modules/funct.f90 index cc5233679f..464ca28993 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -55,7 +55,7 @@ MODULE funct PUBLIC :: set_auxiliary_flags ! ! additional subroutines/functions for hybrid functionals - PUBLIC :: start_exx, stop_exx, get_exx_fraction, exx_is_active + PUBLIC :: start_exx, stop_exx, get_exx_fraction, exx_is_active, scan_exx PUBLIC :: set_exx_fraction, dft_force_hybrid PUBLIC :: set_screening_parameter, get_screening_parameter PUBLIC :: set_gau_parameter, get_gau_parameter @@ -341,6 +341,7 @@ MODULE funct LOGICAL :: ishybrid = .FALSE. LOGICAL :: isnonlocc = .FALSE. LOGICAL :: exx_started = .FALSE. + LOGICAL :: scan_exx = .FALSE. LOGICAL :: has_finite_size_correction = .FALSE. LOGICAL :: finite_size_cell_volume_set = .FALSE. REAL(DP):: finite_size_cell_volume = notset @@ -627,6 +628,7 @@ SUBROUTINE set_dft_from_name( dft_ ) ! valid. IF (imeta==5 .OR. imeta==6) THEN #if defined(__LIBXC) + IF (imeta==6) scan_exx = .TRUE. imeta = 263 imetac = 267 is_libxc(5:6) = .TRUE. @@ -758,8 +760,6 @@ SUBROUTINE set_dft_from_name( dft_ ) CALL errore( 'set_dft_from_name', ' conflicting values for inlc', 1 ) ENDIF ! - !CALL init_xc() - ! RETURN ! END SUBROUTINE set_dft_from_name diff --git a/Modules/xc_mgga_drivers.f90 b/Modules/xc_mgga_drivers.f90 index a16e716236..9a89c4fed1 100644 --- a/Modules/xc_mgga_drivers.f90 +++ b/Modules/xc_mgga_drivers.f90 @@ -1,7 +1,8 @@ MODULE xc_mgga ! USE kinds, ONLY: DP -USE funct, ONLY: get_meta, get_metac, is_libxc +USE funct, ONLY: get_meta, get_metac, is_libxc, & + exx_is_active, scan_exx, get_exx_fraction ! IMPLICIT NONE ! @@ -98,6 +99,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 REAL(DP), ALLOCATABLE :: vc_rho(:), vc_sigma(:), vc_tau(:) REAL(DP), ALLOCATABLE :: lapl_rho(:), vlapl_rho(:) ! not used in TPSS ! + REAL(DP) :: exx_fraction INTEGER :: k, ipol, pol_unpol LOGICAL :: POLARIZED ! @@ -193,6 +195,17 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 ENDDO ENDIF ! + ! ... only for HK/MCA: SCAN0 (used in CPV) + IF ( scan_exx ) THEN + exx_fraction = get_exx_fraction() + IF (exx_is_active()) THEN + ex = (1.0_DP - exx_fraction) * ex + v1x = (1.0_DP - exx_fraction) * v1x + v2x = (1.0_DP - exx_fraction) * v2x + v3x = (1.0_DP - exx_fraction) * v3x + ENDIF + ENDIF + ! ENDIF ! ! META CORRELATION From 686dd6cf6c4bd10e545c27760adaaf218603061b Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Wed, 26 Jun 2019 17:43:00 +0200 Subject: [PATCH 28/95] benchmark_libxc updated and a few fixes --- Modules/metagga.f90 | 8 ++-- Modules/xc_mgga_drivers.f90 | 8 ++-- PP/src/benchmark_libxc.f90 | 74 ++++++++++++++++++++++--------------- 3 files changed, 53 insertions(+), 37 deletions(-) diff --git a/Modules/metagga.f90 b/Modules/metagga.f90 index fb067a2309..94abdcfff4 100644 --- a/Modules/metagga.f90 +++ b/Modules/metagga.f90 @@ -716,11 +716,11 @@ SUBROUTINE metac_spin( rho, zeta, grhoup, grhodw, & ! IF (SQRT(grhodw2) > small) THEN ! - CALL pbec_spin( rhoup, 1.0_DP-small, grhoup2, 1, & - ecup_0, v1_pbe, v2_tmp ) + CALL pbec_spin( rhodw, -1.0_DP+small, grhodw2, 1, & + ecdw_0, v1_0v, v2_tmp ) ! - v1up_0 = v1_pbe(1) - v1dw_0 = v1_pbe(2) + v1up_0 = v1_0v(1) + v1dw_0 = v1_0v(2) ! ELSE ecdw_0 = 0.0_DP diff --git a/Modules/xc_mgga_drivers.f90 b/Modules/xc_mgga_drivers.f90 index 9a89c4fed1..4cb998a5da 100644 --- a/Modules/xc_mgga_drivers.f90 +++ b/Modules/xc_mgga_drivers.f90 @@ -160,7 +160,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 CALL tau_xc( length, rho(:,1), grho2(:,1), tau(:,1), ex, ec, v1x(:,1), & v2x(:,1), v3x(:,1), v1c(:,1), v2c(1,:,1), v3c(:,1) ) ELSEIF (ns == 2) THEN - CALL tau_xc_spin( length, rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, & + CALL tau_xc_spin( length, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, & v2c, v3c ) ENDIF ! @@ -260,7 +260,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 ! ELSEIF (ns == 2) THEN ! - CALL tau_xc_spin( length, rho, grho2, tau, ex, ec, v1x, v2x, v3x, v1c, & + CALL tau_xc_spin( length, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, & v2c, v3c ) ! ENDIF @@ -361,7 +361,7 @@ SUBROUTINE tau_xc_spin( length, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, atau = tau(k,1) + tau(k,2) ! KE-density in Hartree grho2(1) = SUM( grho(:,k,1)**2 ) grho2(2) = SUM( grho(:,k,2)**2 ) - ggrho2 = grho2(1) + grho2(2) + ggrho2 = ( grho2(1) + grho2(2) ) * 4.0_DP ! IF ((rh <= rho_threshold) .OR. (ggrho2 <= grho2_threshold) .OR. (ABS(atau) <= tau_threshold)) CYCLE ! @@ -378,7 +378,7 @@ SUBROUTINE tau_xc_spin( length, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1c, v2c, ! CASE( 2 ) ! - CALL m06lxc_spin( rho(k,1), rho(k,2), grho(:,k,1), grho(:,k,2), tau(k,1), tau(k,2), ex(k), ec(k), & + CALL m06lxc_spin( rho(k,1), rho(k,2), grho2(1), grho2(2), tau(k,1), tau(k,2), ex(k), ec(k), & v1x(k,1), v1x(k,2), v2x(k,1), v2x(k,2), v3x(k,1), v3x(k,2), & v1c(k,1), v1c(k,2), v2c(:,k,1), v2c(:,k,2), v3c(k,1), v3c(k,2) ) ! diff --git a/PP/src/benchmark_libxc.f90 b/PP/src/benchmark_libxc.f90 index 21b13e856f..8f5e9f766c 100644 --- a/PP/src/benchmark_libxc.f90 +++ b/PP/src/benchmark_libxc.f90 @@ -15,7 +15,7 @@ PROGRAM benchmark_libxc !! * derivative of LDA pot. (dmxc) ; !! * GGA ; !! * derivative of GGA pot. (dgcxc, the polarized case is not yet complete) ; - !! * metaGGA. + !! * metaGGA (some discrepancies with the m06_L functional only for correlation potential). ! !------------------------------------------------------------------------------------! ! To be run on a single processor @@ -47,7 +47,8 @@ PROGRAM benchmark_libxc REAL(DP) :: rs(nnr), ec_qe2(nnr), vc_qe2(nnr,2) REAL(DP), ALLOCATABLE :: rho_qe(:,:) REAL(DP), ALLOCATABLE :: rho_tot(:), zeta(:) - REAL(DP), ALLOCATABLE :: grho(:,:,:), grho_ud(:), grho2(:,:), grh2(:) + REAL(DP), ALLOCATABLE :: grho(:,:,:), grhos(:,:,:), & + grho_ud(:), grho2(:,:), grh2(:) REAL(DP), ALLOCATABLE :: tau_qe(:,:) REAL(DP), ALLOCATABLE :: ex_qe(:), ec_qe(:) REAL(DP), ALLOCATABLE :: vx_qe(:,:), vc_qe(:,:) @@ -81,23 +82,27 @@ PROGRAM benchmark_libxc ! ! ******************************************************************************* ! *-----------------------------------------------------------------------------* - ! * libxc funct. indexes: http://bigdft.org/Wiki/index.php?title=XC_codes * - ! * (or use function: 'xc_functional_get_number()' ) * - ! * qe " " : see comments in Modules/funct.f90 * + ! * To find libxc functional indexes: look for the names at: * + ! * * + ! * https://tddft.org/programs/libxc/functionals/ * + ! * * + ! * and then use the function: xc_functional_get_number( 'XC_name' ). * + ! * NOTE: the prefix XC_ is necessary. * + ! * For q-e indexes see the comments in Modules/funct.f90 * ! *-----------------------------------------------------------------------------* ! * * - ! * ... some examples: * + ! * ... a few examples: * ! * * - ! * LDA GGA * - ! * | q-e | libxc | | q-e | libxc | * - ! * |___________|__________| |_________|____________| * - ! * slater (x) | 1 | 1 | Becke88 (x) | 1 | 106 | * - ! * pz (c) | 1 | 9 | PW86(c)-POL | 1 | 132 | * - ! * | | | PW86(c)-UNP | 21 | " | * - ! * wigner (c) | 5 | 2 | PBE (c) | 4 | 130 | * - ! * vwn (c) | 2 | 7 | LYP (c) | 3 | 131 | * - ! * pw (c) | 4 | 12 | PW91 (c) | 2 | 134 | * - ! * ... | ... | ... | ... | ... | ... | * + ! * LDA GGA mGGA * + ! * |qe |lxc| |qe |lxc | |qe |lxc | * + ! * |___|___| |___|____| |___|____| * + ! * Slater (x) | 1 | 1 | Becke88 (x) | 1 |106 | TPSS (x) | 1 |202 | * + ! * PZ (c) | 1 | 9 | PW86(c)-POL | 1 |132 | TPSS (c) | 1 |231 | * + ! * Wigner (c) | 5 | 2 | PW86(c)-UNP |21 | " | m06l (x) | 2 |203 | * + ! * VWN (c) | 2 | 7 | PBE (c) | 4 |130 | m06l (c) | 2 |233 | * + ! * PW (c) | 4 |12 | LYP (c) | 3 |131 | | | | * + ! * | | | PW91 (c) | 2 |134 | | | | * + ! * ... |...|...| ... |...|... | ... |...|... | * ! * * ! ******************************************************************************* ! @@ -109,7 +114,6 @@ PROGRAM benchmark_libxc ! libxc: ec = ec_glyp (icorr=131) / vc = vc_glyp (131) ! ... same for polarized case ! - ! PRINT *, CHAR(10)//" --- BENCHMARK TEST BETWEEN QE AND LIBXC ---"//CHAR(10)//" " ! WRITE (*,'(/,1x,a)', ADVANCE='no') "Derivative of xc?(y/n) " @@ -289,7 +293,7 @@ PROGRAM benchmark_libxc ! rho_lxc = 0.0_DP IF ( GGA .OR. MGGA ) sigma = 0.0_DP - lapl_rho = 0.0_DP + IF (MGGA) lapl_rho = 0.0_DP ! ! -------- Setting up an arbitrary input for both qe and libxc ----- ! @@ -303,10 +307,11 @@ PROGRAM benchmark_libxc grho(ii,1,1) = ABS( 0.05_DP + 0.8_DP*SIN(DBLE(ii)) ) grho(ii,2,1) = ABS( 0.05_DP + 0.7_DP*SIN(DBLE(ii)) ) grho(ii,3,1) = ABS( 0.05_DP + 0.6_DP*SIN(DBLE(ii)) ) + ! + grho2(ii,1) = grho(ii,1,1)**2 + grho(ii,2,1)**2 + grho(ii,3,1)**2 ENDIF - grho2(ii,1) = grho(ii,1,1)**2 + grho(ii,2,1)**2 + grho(ii,3,1)**2 ! - IF ( MGGA ) tau_qe(ii,1) = ABS( 0.05_DP + 0.8_DP*SIN(DBLE(ii)) )*0.5d0 + IF ( MGGA ) tau_qe(ii,1) = ABS( 0.05_DP + 0.8_DP*SIN(DBLE(ii)) )*0.5_DP ! IF ( POLARIZED ) THEN ! @@ -332,7 +337,7 @@ PROGRAM benchmark_libxc ! ENDIF ! - IF ( MGGA ) tau_qe(ii,2) = ABS( 0.05_DP + 0.8_DP*SIN(DBLE(ii)) )*0.2d0 + IF ( MGGA ) tau_qe(ii,2) = ABS( 0.05_DP + 0.8_DP*SIN(DBLE(ii)) )*0.2_DP ! ENDIF ! @@ -592,17 +597,26 @@ PROGRAM benchmark_libxc ! !----- QE ---------- ! - !CALL select_mgga_functionals( iexch_qe, icorr_qe ) ! ... icorr_qe not used - ! - ! CALL set_dft_from_indices( 0, 0, 0, 0, iexch_qe, 0 ) ! ... EXCHANGE and CORRELATION ! IF ( .NOT. POLARIZED ) THEN CALL tau_xc( nnr, rho_qe(:,1), grho2(:,1), tau_qe(:,1), ex_qe, ec_qe, v1x(:,1), & v2x(:,1), v3x(:,1), v1c(:,1), v2cm(1,:,1), v3c(:,1) ) ELSE - CALL tau_xc_spin( nnr, rho_qe, grho2, tau_qe, ex_qe, ec_qe, v1x, v2x, v3x, v1c, & + ALLOCATE( grhos(3,nnr,2) ) + DO ipol = 1, 3 + DO ii = 1, nnr + grhos(ipol,ii,1) = grho(ii,ipol,1) + grhos(ipol,ii,2) = grho(ii,ipol,2) + ENDDO + ENDDO + CALL tau_xc_spin( nnr, rho_qe, grhos, tau_qe, ex_qe, ec_qe, v1x, v2x, v3x, v1c, & v2cm, v3c ) + DEALLOCATE( grhos ) + ENDIF + IF (iexch_qe == 2) THEN + v3x = v3x * 2.0_DP + v3c = v3c * 2.0_DP ENDIF ! ENDIF @@ -621,7 +635,7 @@ PROGRAM benchmark_libxc ! IF ( LDA ) THEN ! - DO ii = 1, nnr, nnr-1 + DO ii = 1, nnr !, nnr-1 WRITE(*,909) ii, nnr IF ( .NOT. POLARIZED ) THEN WRITE (*, 401 ) rho_qe(ii,1) @@ -706,7 +720,6 @@ PROGRAM benchmark_libxc WRITE (*,202) ex_lxc(ii), ec_lxc(ii) PRINT *, " --- " WRITE (*,302) ex_qe(ii)-ex_lxc(ii), ec_qe(ii)-ec_lxc(ii) - !WRITE (*,302) ex_qe(ii)/ex_lxc(ii), ec_qe(ii)/ec_lxc(ii) ! IF (.NOT. ENERGY_ONLY) THEN ! @@ -859,7 +872,6 @@ PROGRAM benchmark_libxc WRITE (*,202) ex_lxc(ii), ec_lxc(ii) PRINT *, " --- " WRITE (*,302) ex_qe(ii)-ex_lxc(ii), ec_qe(ii)-ec_lxc(ii) - !WRITE (*,302) ex_qe(ii)/ex_lxc(ii), ec_qe(ii)/ec_lxc(ii) ! IF (.NOT. ENERGY_ONLY) THEN ! @@ -930,6 +942,10 @@ PROGRAM benchmark_libxc ELSEIF ( POLARIZED ) THEN WRITE (*,102) v2cm(1,ii,1), v2cm(1,ii,2) WRITE (*,203) v2c_lxc(1,ii,1), v2c_lxc(1,ii,2) + !WRITE (*,102) v2cm(2,ii,1), v2cm(2,ii,2) + !WRITE (*,203) v2c_lxc(2,ii,1), v2c_lxc(2,ii,2) + !WRITE (*,102) v2cm(3,ii,1), v2cm(3,ii,2) + !WRITE (*,203) v2c_lxc(3,ii,1), v2c_lxc(3,ii,2) PRINT *, " --- " WRITE (*,303) v2cm(1,ii,1)-v2c_lxc(1,ii,1), v2cm(1,ii,2)-v2c_lxc(1,ii,2) ENDIF @@ -937,7 +953,7 @@ PROGRAM benchmark_libxc PRINT *, " " PRINT *, "=== Correlation potential vtau ===" IF ( .NOT. POLARIZED ) THEN - WRITE (*,101) v3c(ii,1) + WRITE (*,101) v3c(ii,1) WRITE (*,201) vc_tau(ii) PRINT *, " --- " WRITE (*,301) v3c(ii,1)-vc_tau(ii) From d7912f50ccb3ab14ee486a650a508ab540a28733 Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Wed, 26 Jun 2019 17:57:18 +0200 Subject: [PATCH 29/95] A small fix for the dft index check --- Modules/funct.f90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Modules/funct.f90 b/Modules/funct.f90 index 464ca28993..9a6ca40327 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -681,8 +681,7 @@ SUBROUTINE set_dft_from_name( dft_ ) fkind = xc_f90_info_kind( xc_info ) CALL xc_f90_func_end( xc_func ) ENDIF - ! - IF (icorr/=0 .AND. fkind==XC_EXCHANGE_CORRELATION) & + IF (igcc/=0 .AND. fkind==XC_EXCHANGE_CORRELATION) & CALL errore( 'set_dft_from_name', 'An EXCHANGE+CORRELATION functional has & &been found together with a correlation one', 3 ) ! @@ -693,6 +692,16 @@ SUBROUTINE set_dft_from_name( dft_ ) IF (imeta/=0 .AND. (.NOT. is_libxc(5)) .AND. imetac/=0) & CALL errore( 'set_dft_from_name', 'Two conflicting metaGGA functionals & &have been found', 5 ) + ! + fkind = -100 + IF (is_libxc(5)) THEN + CALL xc_f90_func_init( xc_func, xc_info, imeta, 1 ) + fkind = xc_f90_info_kind( xc_info ) + CALL xc_f90_func_end( xc_func ) + ENDIF + IF (imetac/=0 .AND. fkind==XC_EXCHANGE_CORRELATION) & + CALL errore( 'set_dft_from_name', 'An EXCHANGE+CORRELATION functional has & + &been found together with a correlation one', 6 ) #endif ! ENDIF From d02de70a2635c7c536c3b4b05f00ab93fcd5136f Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Wed, 26 Jun 2019 19:46:48 +0200 Subject: [PATCH 30/95] Yet another small step towards XML I/O cleanup: reading of band structure in PW merged with available module routine; removal of some replicated (and in one case, wrong) reading --- Modules/qexsd_copy.f90 | 45 +++++++++++------- PW/src/pw_restart_new.f90 | 96 +-------------------------------------- PW/src/read_file_new.f90 | 20 ++++---- 3 files changed, 42 insertions(+), 119 deletions(-) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 624cbfcc20..dc77775cc7 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -88,8 +88,8 @@ SUBROUTINE qexsd_copy_dim (atomic_structure, band_structure, & ELSE IF ( band_structure%nbnd_up_ispresent .AND. band_structure%nbnd_dw_ispresent) THEN nbnd = ( band_structure%nbnd_up + band_structure%nbnd_dw ) ELSE - CALL errore('init_vars_from_schema: check xml file !!', & - 'nbnd or nbnd_up+nbnd_dw are missing in band_structure element', 1) + CALL errore('qexsd_copy_band_structure', & + 'nbnd or nbnd_up+nbnd_dw missing in xml file', 1) END IF lsda = band_structure%lsda IF ( lsda ) THEN @@ -475,6 +475,8 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & isk, natomwfc, nbnd_up, nbnd_dw, nelec, wk, wg, ef, ef_up, ef_dw, et ) !------------------------------------------------------------------------ ! + ! IMPORTANT NOTICE: IN LSDA CASE CONVERTS TO "PWSCF" LOGIC for k-points + ! USE qes_types_module, ONLY : band_structure_type ! IMPLICIT NONE @@ -489,6 +491,14 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & lsda = band_struct_obj%lsda nkstot = band_struct_obj%nks IF ( lsda) THEN + ! FIXME: make this consistent with qexsd_copy_dim + IF (band_struct_obj%nbnd_ispresent) THEN + nbnd = band_struct_obj%nbnd / 2 + ELSE IF ( band_struct_obj%nbnd_up_ispresent .AND. band_struct_obj%nbnd_dw_ispresent ) THEN + nbnd = (band_struct_obj%nbnd_up + band_struct_obj%nbnd_dw)/2 + ELSE + CALL errore ('qexsd_copy_band_structure: ','both nbnd and nbnd_up+nbnd_dw missing', 1) + END IF nkstot = nkstot * 2 isk(1:nkstot/2) = 1 isk(nkstot/2+1:nkstot) = 2 @@ -497,7 +507,6 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & END IF ! nelec = band_struct_obj%nelec - nbnd = band_struct_obj%nbnd natomwfc = band_struct_obj%num_of_atomic_wfc IF ( band_struct_obj%fermi_energy_ispresent) THEN ef = band_struct_obj%fermi_energy @@ -512,21 +521,25 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & ef_up = 0.d0 ef_dw = 0.d0 END IF + + IF ( band_struct_obj%lsda) THEN + IF ( band_struct_obj%nbnd_up_ispresent .AND. band_struct_obj%nbnd_dw_ispresent) THEN + nbnd_up = band_struct_obj%nbnd_up + nbnd_dw = band_struct_obj%nbnd_dw + ELSE IF ( band_struct_obj%nbnd_up_ispresent ) THEN + nbnd_up = band_struct_obj%nbnd_up + nbnd_dw = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_up + ELSE IF ( band_struct_obj%nbnd_dw_ispresent ) THEN + nbnd_dw = band_struct_obj%nbnd_dw + nbnd_up = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_dw + ELSE + nbnd_up = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 + nbnd_dw = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 + END IF + END IF + ! DO ik =1, band_struct_obj%ndim_ks_energies IF ( band_struct_obj%lsda) THEN - IF ( band_struct_obj%nbnd_up_ispresent .AND. band_struct_obj%nbnd_dw_ispresent) THEN - nbnd_up = band_struct_obj%nbnd_up - nbnd_dw = band_struct_obj%nbnd_dw - ELSE IF ( band_struct_obj%nbnd_up_ispresent ) THEN - nbnd_up = band_struct_obj%nbnd_up - nbnd_dw = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_up - ELSE IF ( band_struct_obj%nbnd_dw_ispresent ) THEN - nbnd_dw = band_struct_obj%nbnd_dw - nbnd_up = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_dw - ELSE - nbnd_up = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 - nbnd_dw = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 - END IF wk(ik) = band_struct_obj%ks_energies(ik)%k_point%weight wk( ik + band_struct_obj%ndim_ks_energies ) = wk(ik) et(1:nbnd_up,ik) = band_struct_obj%ks_energies(ik)%eigenvalues%vector(1:nbnd_up) diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 54b4fff6e7..9c8dc37b1b 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -41,8 +41,7 @@ MODULE pw_restart_new PUBLIC :: pw_write_schema, pw_write_binaries, pw_read_schema, & read_collected_to_evc PUBLIC :: readschema_ef, readschema_magnetization, & - readschema_occupations, readschema_brillouin_zone, & - readschema_band_structure + readschema_occupations, readschema_brillouin_zone ! CONTAINS !------------------------------------------------------------------------ @@ -1130,7 +1129,6 @@ SUBROUTINE readschema_occupations( band_struct_obj ) USE fixed_occ, ONLY : tfixed_occ, f_inp USE ktetra, ONLY : ntetra, tetra_type USE klist, ONLY : ltetra, lgauss, ngauss, degauss, smearing - USE electrons_base, ONLY : nupdwn USE wvfct, ONLY : nbnd USE input_parameters, ONLY : input_parameters_occupations => occupations USE qes_types_module, ONLY : input_type, band_structure_type @@ -1140,19 +1138,6 @@ SUBROUTINE readschema_occupations( band_struct_obj ) TYPE ( band_structure_type ),INTENT(IN) :: band_struct_obj INTEGER :: ispin, nk1, nk2, nk3, aux_dim1, aux_dim2 ! - lsda= band_struct_obj%lsda - nbnd = band_struct_obj%nbnd - IF ( band_struct_obj%nbnd_up_ispresent ) nupdwn(1) = band_struct_obj%nbnd_up - IF ( band_struct_obj%nbnd_dw_ispresent ) nupdwn(2) = band_struct_obj%nbnd_dw - IF ( lsda ) THEN - nspin = 2 - nbnd = nbnd / 2 - ELSE IF ( band_struct_obj%noncolin) THEN - nspin = 4 - ELSE - nspin = 1 - END IF - ! lgauss = .FALSE. ltetra = .FALSE. tetra_type = 0 @@ -1200,85 +1185,6 @@ SUBROUTINE readschema_occupations( band_struct_obj ) END IF ! END SUBROUTINE readschema_occupations - ! - !------------------------------------------------------------------------ - SUBROUTINE readschema_band_structure( band_struct_obj ) - !------------------------------------------------------------------------ - ! - USE constants, ONLY : e2 - USE basis, ONLY : natomwfc - USE lsda_mod, ONLY : lsda, isk - USE klist, ONLY : nkstot, wk, nelec - USE wvfct, ONLY : et, wg, nbnd - USE ener, ONLY : ef, ef_up, ef_dw - USE qes_types_module, ONLY : band_structure_type - ! - IMPLICIT NONE - TYPE ( band_structure_type) :: band_struct_obj - INTEGER :: ik, nbnd_, nbnd_up_, nbnd_dw_ - ! - !! left here to write bw compatible xml - lsda = band_struct_obj%lsda - nkstot = band_struct_obj%nks - IF ( lsda) THEN - IF (band_struct_obj%nbnd_ispresent) THEN - nbnd = band_struct_obj%nbnd / 2 - ELSE IF ( band_struct_obj%nbnd_up_ispresent .AND. band_struct_obj%nbnd_dw_ispresent ) THEN - nbnd = (band_struct_obj%nbnd_up + band_struct_obj%nbnd_dw)/2 - ELSE - CALL errore ('init_vars_from_schema: ','band_structure xml element nbnd and nbnd_up+nbnd_dw missing', 1) - END IF - nkstot = nkstot * 2 - isk(1:nkstot/2) = 1 - isk(nkstot/2+1:nkstot) = 2 - ELSE - isk(1:nkstot) = 1 - END IF - ! - nelec = band_struct_obj%nelec - natomwfc = band_struct_obj%num_of_atomic_wfc - IF ( band_struct_obj%fermi_energy_ispresent) THEN - ef = band_struct_obj%fermi_energy*e2 - ELSE IF ( band_struct_obj%two_fermi_energies_ispresent ) THEN - ef = 0.d0 - ef_up = band_struct_obj%two_fermi_energies(1)*e2 - ef_dw = band_struct_obj%two_fermi_energies(2)*e2 - ELSE - ef = 0.d0 - ef_up = 0.d0 - ef_dw = 0.d0 - END IF - DO ik =1, band_struct_obj%ndim_ks_energies - IF ( band_struct_obj%lsda) THEN - IF ( band_struct_obj%nbnd_up_ispresent .AND. band_struct_obj%nbnd_dw_ispresent) THEN - nbnd_up_ = band_struct_obj%nbnd_up - nbnd_dw_ = band_struct_obj%nbnd_dw - ELSE IF ( band_struct_obj%nbnd_up_ispresent ) THEN - nbnd_up_ = band_struct_obj%nbnd_up - nbnd_dw_ = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_up_ - ELSE IF ( band_struct_obj%nbnd_dw_ispresent ) THEN - nbnd_dw_ = band_struct_obj%nbnd_dw - nbnd_up_ = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_dw_ - ELSE - nbnd_up_ = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 - nbnd_dw_ = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 - END IF - wk(ik) = band_struct_obj%ks_energies(ik)%k_point%weight - wk( ik + band_struct_obj%ndim_ks_energies ) = wk(ik) - et(1:nbnd_up_,ik) = band_struct_obj%ks_energies(ik)%eigenvalues%vector(1:nbnd_up_)*e2 - et(1:nbnd_dw_,ik+band_struct_obj%ndim_ks_energies) = & - band_struct_obj%ks_energies(ik)%eigenvalues%vector(nbnd_up_+1:nbnd_up_+nbnd_dw_)*e2 - wg(1:nbnd_up_,ik) = band_struct_obj%ks_energies(ik)%occupations%vector(1:nbnd_up_)*wk(ik) - wg(1:nbnd_dw_,ik+band_struct_obj%ndim_ks_energies) = & - band_struct_obj%ks_energies(ik)%occupations%vector(nbnd_up_+1:nbnd_up_+nbnd_dw_)*wk(ik) - ELSE - wk(ik) = band_struct_obj%ks_energies(ik)%k_point%weight - nbnd_ = band_struct_obj%ks_energies(ik)%eigenvalues%size - et (1:nbnd_,ik) = band_struct_obj%ks_energies(ik)%eigenvalues%vector(1:nbnd_)*e2 - wg (1:nbnd_,ik) = band_struct_obj%ks_energies(ik)%occupations%vector(1:nbnd_)*wk(ik) - END IF - END DO - END SUBROUTINE readschema_band_structure ! !------------------------------------------------------------------------ SUBROUTINE read_collected_to_evc( dirname ) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 025f0fb792..40ca370a7d 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -105,6 +105,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE force_mod, ONLY : force USE klist, ONLY : nks, nkstot, nelec, wk USE ener, ONLY : ef, ef_up, ef_dw + USE electrons_base, ONLY : nupdwn USE wvfct, ONLY : npwx, nbnd, et, wg USE extfield, ONLY : forcefield, forcegate, tefield, dipfield, & edir, emaxpos, eopreg, eamp, el_dipole, ion_dipole, gate, zgate, & @@ -138,8 +139,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! USE pw_restart_new, ONLY : pw_read_schema, & readschema_magnetization, & - readschema_occupations, readschema_brillouin_zone, & - readschema_band_structure + readschema_occupations, readschema_brillouin_zone USE qes_types_module,ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset @@ -147,7 +147,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) qexsd_copy_dim, qexsd_copy_atomic_species, & qexsd_copy_atomic_structure, qexsd_copy_symmetry, & qexsd_copy_basis_set, qexsd_copy_algorithmic_info,& - qexsd_copy_dft, qexsd_copy_efield + qexsd_copy_dft, qexsd_copy_efield, qexsd_copy_band_structure #if defined(__BEOWULF) USE qes_bcast_module,ONLY : qes_bcast @@ -158,7 +158,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) IMPLICIT NONE LOGICAL, INTENT(OUT) :: wfc_is_collected ! - INTEGER :: i, is, ik, nbnd_up, nbnd_dw, ierr, dum1,dum2,dum3 + INTEGER :: i, is, ik, ierr, dum1,dum2,dum3 LOGICAL :: magnetic_sym, lvalid_input CHARACTER(LEN=20) :: dft_name, vdw_corr REAL(dp) :: exx_fraction, screening_parameter @@ -262,15 +262,19 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL start_exx () END IF !! Band structure section - !!CALL qexsd_copy_band_structure( output_obj%band_structure, lsda, & - !! nkstot, isk, natomwfc, nbnd_up, nbnd_dw, nelec, wk, wg, & - !! ef, ef_up, ef_dw, et ) + CALL qexsd_copy_band_structure( output_obj%band_structure, lsda, & + nkstot, isk, natomwfc, nupdwn(1), nupdwn(2), nelec, wk, wg, & + ef, ef_up, ef_dw, et ) + ! convert to Ry + ef = ef*e2 + ef_up = ef_up*e2 + ef_dw = ef_dw*e2 + et(:,:) = et(:,:)*e2 !! CALL readschema_magnetization ( output_obj%band_structure, & output_obj%magnetization ) CALL readschema_occupations( output_obj%band_structure ) CALL readschema_brillouin_zone( output_obj%band_structure ) - CALL readschema_band_structure( output_obj%band_structure ) !! Symmetry section IF ( lvalid_input ) THEN CALL qexsd_copy_symmetry ( output_obj%symmetries, & From 29c6bfc8be518baa537776aac8f42aab43d7529f Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Thu, 27 Jun 2019 11:00:19 +0200 Subject: [PATCH 31/95] Ford-PW part 1 --- PW/src/acfdt_in_pw.f90 | 5 +- PW/src/add_bfield.f90 | 246 ++++++++++++++++++++--------------- PW/src/add_efield.f90 | 251 ++++++++++++++++++------------------ PW/src/add_vhub_to_deeq.f90 | 13 +- PW/src/add_vuspsi.f90 | 128 +++++++++--------- PW/src/addusstress.f90 | 139 ++++++++++---------- 6 files changed, 415 insertions(+), 367 deletions(-) diff --git a/PW/src/acfdt_in_pw.f90 b/PW/src/acfdt_in_pw.f90 index a278188fab..44f42cb4bd 100644 --- a/PW/src/acfdt_in_pw.f90 +++ b/PW/src/acfdt_in_pw.f90 @@ -9,9 +9,10 @@ ! MODULE acfdt_ener ! - USE kinds, ONLY : DP + USE kinds, ONLY: DP ! - LOGICAL :: acfdt_in_pw = .FALSE. ! the default value is .false. + LOGICAL :: acfdt_in_pw = .FALSE. + !! the default value is .false. REAL(DP) :: acfdt_eband ! END MODULE acfdt_ener diff --git a/PW/src/add_bfield.f90 b/PW/src/add_bfield.f90 index d6d923a993..a3184258c3 100644 --- a/PW/src/add_bfield.f90 +++ b/PW/src/add_bfield.f90 @@ -5,23 +5,22 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! -SUBROUTINE add_bfield (v,rho) - !-------------------------------------------------------------------- +!---------------------------------------------------------------------------- +SUBROUTINE add_bfield( v, rho ) + !-------------------------------------------------------------------------- + !! It adds the B-field contribution to the total potential. ! - ! If noncolinear is set, one can calculate constrains either on - ! the local magnetization, calculated in get_locals or on the - ! total magnetization. + !! If noncolinear is set, one can calculate constrains either on + !! the local magnetization, calculated in get_locals or on the + !! total magnetization. To this end, a "penalty term" of the form: + !! $$ E_p = \text{lambda} * ( m_\text{loc} - m_\text{loc_constr})^2 $$ + !! is added to the energy. Here we calculate the resulting + !! "constraining B-field" and add it to v(ir,2..4) + !! Moreover there is also the possibility to add a fixed + !! magnetic field (apparently disabled at the moment). ! - ! To this end, a "penalty term" of the form - ! E_p = lambda * ( m_loc - m_loc_constr)^2 - ! is added to the energy. Here we calculate the resulting - ! "constraining B-field" and add it to v(ir,2..4) - ! Moreover there is also the possibility to add a fixed - ! magnetic field (apparently disabled at the moment). - ! - ! NB: So far, the contribution of the orbital currents - ! to the magnetization is not included. - ! + !! NB: So far, the contribution of the orbital currents + !! to the magnetization is not included. ! USE kinds, ONLY : DP USE constants, ONLY : pi @@ -34,109 +33,135 @@ SUBROUTINE add_bfield (v,rho) USE mp, ONLY : mp_sum USE noncollin_module, ONLY : bfield, lambda, i_cons, mcons, & pointlist, factlist, noncolin + ! IMPLICIT NONE - ! input/outpt variables + ! REAL(DP), INTENT(IN) :: rho(dfftp%nnr,nspin) - REAL(DP), INTENT(INOUT) :: v(dfftp%nnr, nspin) - ! local variables + !! the charge density + REAL(DP), INTENT(INOUT) :: v(dfftp%nnr,nspin) + !! the total potential + ! + ! ... local variables + ! REAL(DP) :: ma, mperp, xx, fact, m1(3), etcon, fact1(3) - REAL(DP), allocatable :: m2(:,:), m_loc(:,:), r_loc(:) - + REAL(DP), ALLOCATABLE :: m2(:,:), m_loc(:,:), r_loc(:) INTEGER :: ir, ipol, nt, na, npol - + ! + ! etcon=0.D0 - - IF (nspin ==1 .or. i_cons==0) RETURN + ! + IF (nspin==1 .OR. i_cons==0) RETURN ! i_cons==0, no constraint - npol = nspin - 1 ! number of relevant magnetic components - ! 3 for non-collinear case; 1 for collinear case ! - ! get the actual values of the local integrated quantities - IF (i_cons.LT.3) THEN - allocate ( m2(npol,nat), m_loc(npol,nat), r_loc(nat) ) - - CALL get_locals(r_loc, m_loc, rho) - - DO na = 1,nat + npol = nspin - 1 + ! number of relevant magnetic components: + ! 3 for non-collinear case; 1 for collinear case + ! + ! ... gets the actual values of the local integrated quantities + ! + IF (i_cons < 3) THEN + ! + ALLOCATE( m2(npol,nat), m_loc(npol,nat), r_loc(nat) ) + ! + CALL get_locals( r_loc, m_loc, rho ) + ! + DO na = 1, nat + ! nt = ityp(na) + ! IF (i_cons==1) THEN + ! ! i_cons = 1 means that the npol components of the magnetization ! are constrained, they are given in the input-file m2(1:npol,na) = m_loc(1:npol,na) - mcons(1:npol,nt) - do ipol=1,npol + ! + DO ipol = 1, npol etcon = etcon + lambda * m2(ipol,na)*m2(ipol,na) - end do - ELSE IF (i_cons==2) THEN + ENDDO + ! + ELSEIF (i_cons==2) THEN + ! ! i_cons = 2 means that the angle theta between the local ! magn. moment and the z-axis is constrained ! mcons (3,nt) is the cos of the constraining angle theta ! the penalty functional in this case is ! lambda*(m_loc(z)/|m_loc| - cos(theta) )^2 - IF (.NOT. noncolin) CALL errore('add_bfield', & - 'this magnetic constraint only applies to non collinear calculations',2) - ma = dsqrt(m_loc(1,na)**2+m_loc(2,na)**2+m_loc(3,na)**2) - if (ma.lt.1.d-30) call errore('add_bfield', & - 'local magnetization is zero',1) + IF (.NOT. noncolin) CALL errore( 'add_bfield', & + 'this magnetic constraint only applies to non collinear calculations', 2 ) + ! + ma = DSQRT( m_loc(1,na)**2 + m_loc(2,na)**2 + m_loc(3,na)**2 ) + IF (ma<1.d-30) CALL errore( 'add_bfield', & + 'local magnetization is zero', 1 ) + ! xx=(m_loc(3,na)/ma - mcons(3,nt)) + ! m2(1,na) = - xx*m_loc(1,na)*m_loc(3,na) / (ma*ma*ma) m2(2,na) = - xx*m_loc(2,na)*m_loc(3,na) / (ma*ma*ma) m2(3,na) = xx*(-m_loc(3,na)*m_loc(3,na) / (ma*ma*ma) + 1.d0/ma) - etcon = etcon + & - lambda * (m_loc(3,na)/ma - mcons(3,nt))**2 - - END IF - END DO ! na - - if (noncolin) then + ! + etcon = etcon + lambda * (m_loc(3,na)/ma - mcons(3,nt))**2 + ! + ENDIF + ! + ENDDO ! na + ! + IF (noncolin) THEN + ! DO ir = 1, dfftp%nnr - if (pointlist(ir) .eq. 0 ) cycle + IF (pointlist(ir) == 0 ) CYCLE fact = 2.D0*lambda*factlist(ir)*omega/(dfftp%nr1*dfftp%nr2*dfftp%nr3) DO ipol = 1,3 v(ir,ipol+1) = v(ir,ipol+1) + fact*m2(ipol,pointlist(ir)) - END DO ! ipol - END DO ! points - else + ENDDO ! ipol + ENDDO ! points + ! + ELSE + ! DO ir = 1, dfftp%nnr - if (pointlist(ir) .eq. 0 ) cycle + IF (pointlist(ir) == 0 ) CYCLE fact = 2.D0*lambda*factlist(ir)*omega/(dfftp%nr1*dfftp%nr2*dfftp%nr3) v(ir,1) = v(ir,1) + fact*m2(1,pointlist(ir)) v(ir,2) = v(ir,2) - fact*m2(1,pointlist(ir)) END DO ! points - end if - deallocate (m2, m_loc, r_loc) - - write (stdout,'(4x,a,F15.8)' ) " constraint energy (Ryd) = ", etcon - ELSE IF (i_cons==3.or.i_cons==6) THEN + ! + ENDIF + ! + DEALLOCATE( m2, m_loc, r_loc ) + ! + WRITE( stdout,'(4x,a,F15.8)' ) " constraint energy (Ryd) = ", etcon + ! + ELSEIF (i_cons==3 .OR. i_cons==6) THEN + ! m1 = 0.d0 DO ipol = 1, npol - DO ir = 1,dfftp%nnr + DO ir = 1, dfftp%nnr m1(ipol) = m1(ipol) + rho(ir,ipol+1) - END DO + ENDDO m1(ipol) = m1(ipol) * omega / ( dfftp%nr1 * dfftp%nr2 * dfftp%nr3 ) - END DO + ENDDO CALL mp_sum( m1, intra_bgrp_comm ) - + ! IF (i_cons==3) THEN IF (npol==1) THEN fact = 2.D0*lambda - bfield(1)=-fact*(m1(1)-mcons(1,1)) - DO ir =1,dfftp%nnr - v(ir,1) = v(ir,1)-bfield(1) - v(ir,2) = v(ir,2)+bfield(1) - END DO + bfield(1) = -fact*(m1(1) - mcons(1,1)) + DO ir = 1, dfftp%nnr + v(ir,1) = v(ir,1) - bfield(1) + v(ir,2) = v(ir,2) + bfield(1) + ENDDO ELSE fact = 2.D0*lambda DO ipol=1,3 - bfield(ipol)=-fact*(m1(ipol)-mcons(ipol,1)) - DO ir =1,dfftp%nnr - v(ir,ipol+1) = v(ir,ipol+1)-bfield(ipol) - END DO - END DO - END IF - write(stdout,'(5x," External magnetic field: ", 3f13.5)') & - (bfield(ipol),ipol=1,npol) - END IF - + bfield(ipol) = -fact*(m1(ipol) - mcons(ipol,1)) + DO ir = 1, dfftp%nnr + v(ir,ipol+1) = v(ir,ipol+1) - bfield(ipol) + ENDDO + ENDDO + ENDIF + WRITE( stdout, '(5x," External magnetic field: ", 3f13.5)') & + ( bfield(ipol), ipol=1,npol ) + ENDIF + ! IF (i_cons==6) THEN ! IF (.NOT. noncolin) CALL errore('add_bfield', & @@ -147,10 +172,13 @@ SUBROUTINE add_bfield (v,rho) ! modulus and azimuthal component of the magnetization: ma = SQRT(m1(1)**2 + m1(2)**2 + m1(3)**2) mperp = SQRT(m1(1)**2 + m1(2)**2) + ! IF (ma < 1.D-12) CALL errore('add_bfield', & 'magnetization too small, cannot constrain polar angle', 1) + ! fact = ACOS(m1(3)/ma) xx = fact - mcons(3,1)/180.D0*pi + ! IF (mperp < 1.D-14) THEN fact1(1:2) = 0.D0 ! when m is along z, in order to allow the magnetization to rotate @@ -160,46 +188,56 @@ SUBROUTINE add_bfield (v,rho) fact1(1:2) = m1(1:2)/mperp * m1(3)/ma/ma ENDIF fact1(3) = - SQRT(1.D0 - (m1(3)/ma)**2)/ma + ! etcon = lambda * xx**2 bfield(:) = 2.D0 * lambda * xx * fact1(:) - DO ipol = 1,3 - DO ir =1,dfftp%nnr - v(ir,ipol+1) = v(ir,ipol+1)+bfield(ipol) - END DO - END DO ! - write(stdout,'(/,5x,"Constraint on the polar angle of the magnetization")') + DO ipol = 1, 3 + DO ir = 1, dfftp%nnr + v(ir,ipol+1) = v(ir,ipol+1) + bfield(ipol) + ENDDO + ENDDO + ! + WRITE(stdout,'(/,5x,"Constraint on the polar angle of the magnetization")') ! N.B.: since the magnetization is here computed starting from the mixed ! rho (i.e. the input rho for the next scf iteration), as all the other ! contributions to the potential for the next iteration, it will differ ! from the magnetization written on output, since that is calculated ! with the output rho of the current iteration. At convergence the two ! magnetizations will coincide (and so will do the polar angles). - write(stdout,'(5x,"theta (target): ",F10.5," (",F10.5,")")') & - ACOS(m1(3)/ma)*180.d0/pi, mcons(3,1) - write(stdout,'(5x,"E_constraint: ",F15.9," (lambda:",F15.9,")")') etcon, lambda - write(stdout,'(5x,"External magnetic field: ", 3F12.6)') bfield(1:npol) - !write(stdout,'(5x,"Magnetization : ", 3F12.6)') m1(1:npol) + WRITE(stdout,'(5x,"theta (target): ",F10.5," (",F10.5,")")') & + ACOS(m1(3)/ma)*180.d0/pi, mcons(3,1) + WRITE(stdout,'(5x,"E_constraint: ",F15.9," (lambda:",F15.9,")")') etcon, lambda + WRITE(stdout,'(5x,"External magnetic field: ", 3F12.6)') bfield(1:npol) + ! WRITE(stdout,'(5x,"Magnetization : ", 3F12.6)') m1(1:npol) ! - END IF - ELSE IF (i_cons==4) THEN - write(stdout,'(5x," External magnetic field: ", 3f13.5)') & - (bfield(ipol),ipol=1,npol) + ENDIF + ! + ELSEIF (i_cons==4) THEN + ! + WRITE(stdout,'(5x," External magnetic field: ", 3f13.5)') & + (bfield(ipol), ipol=1,npol) + ! IF (npol==1) THEN - DO ir =1,dfftp%nnr - v(ir,1) = v(ir,1)-bfield(ipol) - v(ir,2) = v(ir,2)+bfield(ipol) - END DO + DO ir = 1, dfftp%nnr + v(ir,1) = v(ir,1) - bfield(ipol) + v(ir,2) = v(ir,2) + bfield(ipol) + ENDDO ELSE - DO ipol = 1,3 - DO ir =1,dfftp%nnr - v(ir,ipol+1) = v(ir,ipol+1)-bfield(ipol) - END DO - END DO - END IF + DO ipol = 1, 3 + DO ir = 1, dfftp%nnr + v(ir,ipol+1) = v(ir,ipol+1) - bfield(ipol) + ENDDO + ENDDO + ENDIF + ! ELSE - CALL errore('add_bfield','i_cons not programmed',1) - END IF - + ! + CALL errore( 'add_bfield','i_cons not programmed', 1 ) + ! + ENDIF + ! + ! RETURN + ! END SUBROUTINE add_bfield diff --git a/PW/src/add_efield.f90 b/PW/src/add_efield.f90 index 80482440bf..f933d5f40e 100644 --- a/PW/src/add_efield.f90 +++ b/PW/src/add_efield.f90 @@ -24,109 +24,108 @@ ! !-------------------------------------------------------------------------- -SUBROUTINE add_efield(vpoten,etotefield,rho,iflag) +SUBROUTINE add_efield( vpoten, etotefield, rho, iflag ) !-------------------------------------------------------------------------- + !! This routine adds an electric field to the local potential. The + !! field is made artificially periodic by introducing a saw-tooth + !! potential. The field is parallel to a reciprocal lattice vector bg, + !! according to the index edir. + ! + !! * If \(\textit{dipfield}\) is false the electric field correction is + !! added to the potential given as input (the bare local potential) + !! only at the first call to this routine. In the following calls the + !! routine exit. + !! * If \(\textit{dipfield}\) is true the dipole moment per unit surface + !! is calculated and used to cancel the electric field due to periodic + !! boundary conditions. This potential is added to the Hartree and + !! xc potential in v_of_rho. NB: in this case the electric field + !! contribution to the band energy is subtracted by deband. + ! + USE kinds, ONLY: DP + USE constants, ONLY: fpi, eps8, e2, au_debye + USE ions_base, ONLY: nat, ityp, zv + USE cell_base, ONLY: alat, at, omega, bg + USE extfield, ONLY: tefield, dipfield, edir, eamp, emaxpos, saw, & + eopreg, forcefield, el_dipole, ion_dipole, tot_dipole + USE force_mod, ONLY: lforce + USE io_global, ONLY: stdout,ionode + USE control_flags, ONLY: mixing_beta + USE lsda_mod, ONLY: nspin + USE mp_images, ONLY: intra_image_comm + USE mp_bands, ONLY: me_bgrp + USE fft_base, ONLY: dfftp + USE mp, ONLY: mp_bcast, mp_sum + USE control_flags, ONLY: iverbosity ! - ! This routine adds an electric field to the local potential. The - ! field is made artificially periodic by introducing a saw-tooth - ! potential. The field is parallel to a reciprocal lattice vector bg, - ! according to the index edir. - ! - ! if dipfield is false the electric field correction is added to the - ! potential given as input (the bare local potential) only - ! at the first call to this routine. In the following calls - ! the routine exit. - ! - ! if dipfield is true the dipole moment per unit surface is calculated - ! and used to cancel the electric field due to periodic boundary - ! conditions. This potential is added to the Hartree and xc potential - ! in v_of_rho. NB: in this case the electric field contribution to the - ! band energy is subtracted by deband. - ! - ! - USE kinds, ONLY : DP - USE constants, ONLY : fpi, eps8, e2, au_debye - USE ions_base, ONLY : nat, ityp, zv - USE cell_base, ONLY : alat, at, omega, bg - USE extfield, ONLY : tefield, dipfield, edir, eamp, emaxpos, saw, & - eopreg, forcefield, el_dipole, ion_dipole, tot_dipole - USE force_mod, ONLY : lforce - USE io_global, ONLY : stdout,ionode - USE control_flags, ONLY : mixing_beta - USE lsda_mod, ONLY : nspin - USE mp_images, ONLY : intra_image_comm - USE mp_bands, ONLY : me_bgrp - USE fft_base, ONLY : dfftp - USE mp, ONLY : mp_bcast, mp_sum - USE control_flags, ONLY : iverbosity - IMPLICIT NONE ! - ! I/O variables - ! - REAL(DP),INTENT(INOUT) :: vpoten(dfftp%nnr)! ef is added to this potential - REAL(DP),INTENT(INOUT) :: etotefield ! contribution to etot due to ef - REAL(DP),INTENT(IN) :: rho(dfftp%nnr) ! the density whose dipole is computed - LOGICAL,INTENT(IN) :: iflag ! set to true to force recalculation of field + REAL(DP), INTENT(INOUT) :: vpoten(dfftp%nnr) + !! ef is added to this potential + REAL(DP), INTENT(INOUT) :: etotefield + !! contribution to etot due to ef + REAL(DP), INTENT(IN) :: rho(dfftp%nnr) + !! the density whose dipole is computed + LOGICAL,INTENT(IN) :: iflag + !! set to true to force recalculation of field ! - ! local variables + ! ... local variables ! INTEGER :: idx, i, j, k, j0, k0 INTEGER :: ir, na, ipol REAL(DP) :: length, vamp, value, sawarg, bmod - + ! LOGICAL :: first=.TRUE. SAVE first - + ! !--------------------- ! Execution control !--------------------- - + ! IF (.NOT.tefield) RETURN ! efield only needs to be added on the first iteration, if dipfield ! is not used. note that for relax calculations it has to be added ! again on subsequent relax steps. IF ((.NOT.dipfield).AND.(.NOT.first) .AND..NOT. iflag) RETURN first=.FALSE. - - IF ((edir.lt.1).or.(edir.gt.3)) THEN - CALL errore('add_efield',' wrong edir',1) + ! + IF ((edir<1).OR.(edir>3)) THEN + CALL errore( 'add_efield', ' wrong edir', 1 ) ENDIF - + ! !--------------------- ! Variable initialization !--------------------- - - bmod=SQRT(bg(1,edir)**2+bg(2,edir)**2+bg(3,edir)**2) - + ! + bmod = SQRT(bg(1,edir)**2+bg(2,edir)**2+bg(3,edir)**2) + ! tot_dipole = 0._dp el_dipole = 0._dp ion_dipole = 0._dp - - !--------------------- - ! Calculate dipole - !--------------------- - - if (dipfield) then - ! - ! dipole correction is active ! - CALL compute_el_dip(emaxpos, eopreg, edir, rho, el_dipole) - CALL compute_ion_dip(emaxpos, eopreg, edir, ion_dipole) - - tot_dipole = -el_dipole + ion_dipole - CALL mp_bcast(tot_dipole, 0, intra_image_comm) - ! - ! E_{TOT} = -e^{2} \left( eamp - dip \right) dip \frac{\Omega}{4\pi} - ! - etotefield=-e2*(eamp-tot_dipole/2.d0)*tot_dipole*omega/fpi - !--------------------- - ! Define forcefield - ! - ! F_{s} = e^{2} \left( eamp - dip \right) z_{v}\cross\frac{\vec{b_{3}}}{bmod} + ! Calculate dipole !--------------------- - + ! + IF (dipfield) THEN + ! + ! dipole correction is active + ! + CALL compute_el_dip( emaxpos, eopreg, edir, rho, el_dipole ) + CALL compute_ion_dip( emaxpos, eopreg, edir, ion_dipole ) + ! + tot_dipole = -el_dipole + ion_dipole + CALL mp_bcast( tot_dipole, 0, intra_image_comm ) + ! + ! E_{TOT} = -e^{2} \left( eamp - dip \right) dip \frac{\Omega}{4\pi} + ! + etotefield = -e2 * (eamp-tot_dipole/2.d0) * tot_dipole * omega/fpi + ! + !--------------------- + ! Define forcefield + ! + ! F_{s} = e^{2} \left( eamp - dip \right) z_{v}\cross\frac{\vec{b_{3}}}{bmod} + !--------------------- + ! IF (lforce) THEN DO na=1,nat DO ipol=1,3 @@ -135,54 +134,48 @@ SUBROUTINE add_efield(vpoten,etotefield,rho,iflag) ENDDO ENDDO ENDIF - - else - ! - ! dipole correction is not active - ! - - CALL compute_ion_dip(emaxpos, eopreg, edir, ion_dipole) - - ! - ! E_{TOT} = -e^{2} eamp * iondip \frac{\Omega}{4\pi} - ! + ! + ELSE + ! + ! dipole correction is not active + ! + CALL compute_ion_dip( emaxpos, eopreg, edir, ion_dipole ) + ! + ! E_{TOT} = -e^{2} eamp * iondip \frac{\Omega}{4\pi} + ! etotefield=-e2*eamp*ion_dipole*omega/fpi - - !--------------------- - ! Define forcefield - ! - ! F_{s} = e^{2} eamp z_{v}\cross\frac{\vec{b_{3}}}{bmod} - !--------------------- - + !--------------------- + ! Define forcefield + ! + ! F_{s} = e^{2} eamp z_{v}\cross\frac{\vec{b_{3}}}{bmod} + !--------------------- + ! IF (lforce) THEN - DO na=1,nat - DO ipol=1,3 - forcefield(ipol,na)= e2 *eamp & - *zv(ityp(na))*bg(ipol,edir)/bmod + DO na = 1, nat + DO ipol = 1, 3 + forcefield(ipol,na) = e2 * eamp * & + zv(ityp(na))*bg(ipol,edir)/bmod ENDDO ENDDO ENDIF - - end if - + ! + ENDIF ! ! Calculate potential and print values ! - - length=(1._dp-eopreg)*(alat*SQRT(at(1,edir)**2+at(2,edir)**2+at(3,edir)**2)) - - vamp=e2*(eamp-tot_dipole)*length - + length = (1._dp-eopreg)*(alat*SQRT(at(1,edir)**2+at(2,edir)**2+at(3,edir)**2)) + ! + vamp = e2*(eamp-tot_dipole)*length + ! IF (ionode) THEN ! ! Output data ! WRITE( stdout,*) WRITE( stdout,'(5x,"Adding external electric field":)') - - IF (dipfield) then + ! + IF (dipfield) THEN WRITE( stdout,'(/5x,"Computed dipole along edir(",i1,") : ")' ) edir - ! ! If verbose prints also the different components ! @@ -192,38 +185,38 @@ SUBROUTINE add_efield(vpoten,etotefield,rho,iflag) WRITE( stdout, '(8X,"Ion. dipole ",1F15.4," Ry au, ", 1F15.4," Debye")' ) & ion_dipole, (ion_dipole*au_debye) ENDIF - + ! WRITE( stdout, '(8X,"Dipole ",1F15.4," Ry au, ", 1F15.4," Debye")' ) & (tot_dipole* (omega/fpi)), & ((tot_dipole* (omega/fpi))*au_debye) - + ! WRITE( stdout, '(8x,"Dipole field ", 1F15.4," Ry au, ")') & tot_dipole WRITE( stdout,*) - + ! ENDIF - IF (abs(eamp)>0._dp) WRITE( stdout, & + IF (ABS(eamp)>0._dp) WRITE( stdout, & '(8x,"E field amplitude [Ha a.u.]: ", es11.4)') eamp - + ! WRITE( stdout,'(8x,"Potential amp. ", f11.4," Ry")') vamp WRITE( stdout,'(8x,"Total length ", f11.4," bohr")') length WRITE( stdout,*) ENDIF - - ! !------------------------------ ! Add potential ! - ! V\left(ijk\right) = e^{2} \left( eamp - dip \right) z_{v} + ! V\left(ijk\right) = e^{2} \left( eamp - dip \right) z_{v} ! Saw\left( \frac{k}{nr3} \right) \frac{alat}{bmod} ! !--------------------- - ! ! Loop in the charge array - j0 = dfftp%my_i0r2p ; k0 = dfftp%my_i0r3p + ! + j0 = dfftp%my_i0r2p + k0 = dfftp%my_i0r3p + ! DO ir = 1, dfftp%nr1x*dfftp%my_nr2p*dfftp%my_nr3p ! ! ... three dimensional indexes @@ -236,24 +229,24 @@ SUBROUTINE add_efield(vpoten,etotefield,rho,iflag) idx = idx - dfftp%nr1x * j j = j + j0 i = idx - + ! ! ... do not include points outside the physical range - + ! IF ( i >= dfftp%nr1 .OR. j >= dfftp%nr2 .OR. k >= dfftp%nr3 ) CYCLE - - if (edir.eq.1) sawarg = DBLE(i)/DBLE(dfftp%nr1) - if (edir.eq.2) sawarg = DBLE(j)/DBLE(dfftp%nr2) - if (edir.eq.3) sawarg = DBLE(k)/DBLE(dfftp%nr3) - + ! + IF (edir==1) sawarg = DBLE(i)/DBLE(dfftp%nr1) + IF (edir==2) sawarg = DBLE(j)/DBLE(dfftp%nr2) + IF (edir==3) sawarg = DBLE(k)/DBLE(dfftp%nr3) + ! value = e2*(eamp - tot_dipole)*saw(emaxpos,eopreg,sawarg) * (alat/bmod) - + ! vpoten(ir) = vpoten(ir) + value - - END DO - - + ! + ENDDO + ! + ! RETURN - + ! END SUBROUTINE add_efield ! diff --git a/PW/src/add_vhub_to_deeq.f90 b/PW/src/add_vhub_to_deeq.f90 index 2d350ee623..4767a06666 100644 --- a/PW/src/add_vhub_to_deeq.f90 +++ b/PW/src/add_vhub_to_deeq.f90 @@ -5,9 +5,10 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! -SUBROUTINE add_vhub_to_deeq(deeq) - ! - ! Add Hubbard contributions to deeq when U_projection is pseudo +SUBROUTINE add_vhub_to_deeq( deeq ) +!----------------------------------------------------------------- + !! Add Hubbard contributions to the integral of V_eff and Q_{nm} when + !! U_projection is pseudo. ! USE kinds, ONLY : DP USE ions_base, ONLY : nat, ntyp => nsp, ityp @@ -15,8 +16,14 @@ SUBROUTINE add_vhub_to_deeq(deeq) USE lsda_mod, ONLY : nspin USE scf, ONLY : v USE ldaU, ONLY : is_hubbard, Hubbard_l, offsetU, q_ae + ! IMPLICIT NONE + ! REAL(KIND=DP), INTENT(INOUT) :: deeq( nhm, nhm, nat, nspin ) + !! integral of V_eff and Q_{nm} + ! + ! ... local variables + ! INTEGER :: na, nt, ih, jh, ijh, m1, m2, ow1, ow2 ! ! diff --git a/PW/src/add_vuspsi.f90 b/PW/src/add_vuspsi.f90 index 1649c534f3..e575151819 100644 --- a/PW/src/add_vuspsi.f90 +++ b/PW/src/add_vuspsi.f90 @@ -9,38 +9,37 @@ !---------------------------------------------------------------------------- SUBROUTINE add_vuspsi( lda, n, m, hpsi ) !---------------------------------------------------------------------------- + !! This routine applies the Ultra-Soft Hamiltonian to a + !! vector psi and puts the result in hpsi. + !! It requires the products of psi with all beta functions + !! in array becp(nkb,m) (calculated by calbec). ! - ! This routine applies the Ultra-Soft Hamiltonian to a - ! vector psi and puts the result in hpsi. - ! Requires the products of psi with all beta functions - ! in array becp(nkb,m) (calculated by calbec) - ! input: - ! lda leading dimension of arrays psi, spsi - ! n true dimension of psi, spsi - ! m number of states psi - ! output: - ! hpsi V_US|psi> is added to hpsi - ! - USE kinds, ONLY: DP - USE ions_base, ONLY: nat, ntyp => nsp, ityp - USE lsda_mod, ONLY: current_spin - USE control_flags, ONLY: gamma_only + USE kinds, ONLY: DP + USE ions_base, ONLY: nat, ntyp => nsp, ityp + USE lsda_mod, ONLY: current_spin + USE control_flags, ONLY: gamma_only USE noncollin_module - USE uspp, ONLY: vkb, nkb, deeq, deeq_nc, indv_ijkb0 - USE uspp_param, ONLY: nh, nhm - USE becmod, ONLY: bec_type, becp + USE uspp, ONLY: vkb, nkb, deeq, deeq_nc, indv_ijkb0 + USE uspp_param, ONLY: nh, nhm + USE becmod, ONLY: bec_type, becp ! IMPLICIT NONE ! ! ... I/O variables ! - INTEGER, INTENT(IN) :: lda, n, m - COMPLEX(DP), INTENT(INOUT) :: hpsi(lda*npol,m) + INTEGER, INTENT(IN) :: lda + !! leading dimension of arrays psi, spsi + INTEGER, INTENT(IN) :: n + !! true dimension of psi, spsi + INTEGER, INTENT(IN) :: m + !! number of states psi + COMPLEX(DP), INTENT(INOUT) :: hpsi(lda*npol,m) + !! V_US|psi> is added to hpsi ! ! ... here the local variables ! INTEGER :: jkb, ikb, ih, jh, na, nt, ibnd - ! counters + ! counters ! ! CALL start_clock( 'add_vuspsi' ) @@ -51,13 +50,13 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi ) ! ELSE IF ( noncolin) THEN ! - CALL add_vuspsi_nc () + CALL add_vuspsi_nc() ! ELSE ! CALL add_vuspsi_k() ! - END IF + ENDIF ! CALL stop_clock( 'add_vuspsi' ) ! @@ -68,10 +67,12 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi ) !----------------------------------------------------------------------- SUBROUTINE add_vuspsi_gamma() !----------------------------------------------------------------------- + !! See comments inside ! USE mp, ONLY: mp_get_comm_null, mp_circular_shift_left ! IMPLICIT NONE + ! INTEGER, EXTERNAL :: ldim_block, gind_block REAL(DP), ALLOCATABLE :: ps (:,:) INTEGER :: ierr @@ -79,7 +80,7 @@ SUBROUTINE add_vuspsi_gamma() ! IF ( nkb == 0 ) RETURN ! - IF( becp%comm == mp_get_comm_null() ) THEN + IF ( becp%comm == mp_get_comm_null() ) THEN nproc = 1 mype = 0 m_loc = m @@ -96,10 +97,10 @@ SUBROUTINE add_vuspsi_gamma() m_begin = becp%ibnd_begin m_max = SIZE( becp%r, 2 ) IF( ( m_begin + m_loc - 1 ) > m ) m_loc = m - m_begin + 1 - END IF + ENDIF ! - ALLOCATE (ps (nkb,m_max), STAT=ierr ) - IF( ierr /= 0 ) & + ALLOCATE( ps (nkb,m_max), STAT=ierr ) + IF ( ierr /= 0 ) & CALL errore( ' add_vuspsi_gamma ', ' cannot allocate ps ', ABS(ierr) ) ! ps(:,:) = 0.D0 @@ -122,13 +123,13 @@ SUBROUTINE add_vuspsi_gamma() deeq(1,1,na,current_spin), nhm, & becp%r(indv_ijkb0(na)+1,1), nkb, 0.0_dp, & ps(indv_ijkb0(na)+1,1), nkb ) - END IF + ENDIF ! - END IF + ENDIF ! - END DO + ENDDO ! - END DO + ENDDO ! IF( becp%comm == mp_get_comm_null() ) THEN ! @@ -144,28 +145,28 @@ SUBROUTINE add_vuspsi_gamma() icur_blk = mype ! DO icyc = 0, nproc - 1 - + ! m_loc = ldim_block( becp%nbnd , nproc, icur_blk ) m_begin = gind_block( 1, becp%nbnd, nproc, icur_blk ) - + ! IF( ( m_begin + m_loc - 1 ) > m ) m_loc = m - m_begin + 1 - + ! IF( m_loc > 0 ) THEN CALL DGEMM( 'N', 'N', ( 2 * n ), m_loc, nkb, 1.D0, vkb, & ( 2 * lda ), ps, nkb, 1.D0, hpsi( 1, m_begin ), ( 2 * lda ) ) - END IF - + ENDIF + ! ! block rotation ! CALL mp_circular_shift_left( ps, icyc, becp%comm ) - + ! icur_blk = icur_blk + 1 IF( icur_blk == nproc ) icur_blk = 0 - - END DO - END IF + ! + ENDDO + ENDIF ! - DEALLOCATE (ps) + DEALLOCATE( ps ) ! RETURN ! @@ -174,23 +175,23 @@ END SUBROUTINE add_vuspsi_gamma !----------------------------------------------------------------------- SUBROUTINE add_vuspsi_k() !----------------------------------------------------------------------- - ! - ! see add_vuspsi_gamma for comments + !! See add_vuspsi_gamma for comments ! IMPLICIT NONE - COMPLEX(DP), ALLOCATABLE :: ps (:,:), deeaux (:,:) + ! + COMPLEX(DP), ALLOCATABLE :: ps(:,:), deeaux(:,:) INTEGER :: ierr ! IF ( nkb == 0 ) RETURN ! - ALLOCATE (ps (nkb,m), STAT=ierr ) + ALLOCATE( ps(nkb,m), STAT=ierr ) IF( ierr /= 0 ) & CALL errore( ' add_vuspsi_k ', ' cannot allocate ps ', ABS( ierr ) ) ! DO nt = 1, ntyp ! IF ( nh(nt) == 0 ) CYCLE - ALLOCATE ( deeaux(nh(nt),nh(nt)) ) + ALLOCATE( deeaux(nh(nt),nh(nt)) ) DO na = 1, nat ! IF ( ityp(na) == nt ) THEN @@ -204,17 +205,17 @@ SUBROUTINE add_vuspsi_k() deeaux, nh(nt), becp%k(indv_ijkb0(na)+1,1), nkb, & (0.0_dp, 0.0_dp), ps(indv_ijkb0(na)+1,1), nkb ) ! - END IF + ENDIF ! - END DO - DEALLOCATE (deeaux) + ENDDO + DEALLOCATE( deeaux ) ! - END DO + ENDDO ! CALL ZGEMM( 'N', 'N', n, m, nkb, ( 1.D0, 0.D0 ) , vkb, & lda, ps, nkb, ( 1.D0, 0.D0 ) , hpsi, lda ) ! - DEALLOCATE (ps) + DEALLOCATE( ps ) ! RETURN ! @@ -223,19 +224,20 @@ END SUBROUTINE add_vuspsi_k !----------------------------------------------------------------------- SUBROUTINE add_vuspsi_nc() !----------------------------------------------------------------------- - ! see add_vuspsi_k for comments + !! See add_vuspsi_k for comments ! IMPLICIT NONE - COMPLEX(DP), ALLOCATABLE :: ps (:,:,:) + ! + COMPLEX(DP), ALLOCATABLE :: ps(:,:,:) INTEGER :: ierr, ijkb0 ! IF ( nkb == 0 ) RETURN ! - ALLOCATE (ps( nkb,npol, m), STAT=ierr ) + ALLOCATE( ps( nkb,npol, m), STAT=ierr ) IF( ierr /= 0 ) & CALL errore( ' add_vuspsi_nc ', ' error allocating ps ', ABS( ierr ) ) ! - ps (:,:,:) = (0.d0, 0.d0) + ps(:,:,:) = (0.d0, 0.d0) ! DO nt = 1, ntyp ! @@ -261,22 +263,22 @@ SUBROUTINE add_vuspsi_nc() deeq_nc(ih,jh,na,3)*becp%nc(jkb,1,ibnd)+& deeq_nc(ih,jh,na,4)*becp%nc(jkb,2,ibnd) ! - END DO + ENDDO ! - END DO + ENDDO ! - END DO + ENDDO ! - END IF + ENDIF ! - END DO + ENDDO ! - END DO + ENDDO ! - call ZGEMM ('N', 'N', n, m*npol, nkb, ( 1.D0, 0.D0 ) , vkb, & + CALL ZGEMM('N', 'N', n, m*npol, nkb, ( 1.D0, 0.D0 ) , vkb, & lda, ps, nkb, ( 1.D0, 0.D0 ) , hpsi, lda ) ! - DEALLOCATE (ps) + DEALLOCATE( ps ) ! RETURN ! diff --git a/PW/src/addusstress.f90 b/PW/src/addusstress.f90 index d56699204a..52bb025324 100644 --- a/PW/src/addusstress.f90 +++ b/PW/src/addusstress.f90 @@ -6,66 +6,74 @@ ! or http://www.gnu.org/copyleft/gpl.txt . ! !---------------------------------------------------------------------- -SUBROUTINE addusstress (sigmanlc) +SUBROUTINE addusstress( sigmanlc ) !---------------------------------------------------------------------- + !! Driver routine to compute the part of the crystal stress which is due + !! to the dependence of the Q function on the atomic position. ! - USE kinds, ONLY : dp - USE control_flags,ONLY : tqr - USE realus, ONLY : addusstress_r + USE kinds, ONLY : dp + USE control_flags, ONLY : tqr + USE realus, ONLY : addusstress_r ! IMPLICIT NONE - REAL(dp), INTENT(INOUT) :: sigmanlc (3, 3) - REAL(dp) :: sigma_r(3,3), sigma_g(3,3) - INTEGER :: na,ijh, ipol,jpol + ! + REAL(DP), INTENT(INOUT) :: sigmanlc(3, 3) + !! the nonlocal stress + ! + ! ... local variables + ! + REAL(DP) :: sigma_r(3,3), sigma_g(3,3) + INTEGER :: na,ijh, ipol,jpol ! IF ( tqr ) THEN sigma_r(:,:) = 0.d0 - CALL addusstress_r (sigma_r ) + CALL addusstress_r( sigma_r ) !WRITE (6,'(A)') 'addusstress_r' !WRITE (6,'(3f13.8)') sigma_r sigmanlc = sigmanlc + sigma_r sigma_g(:,:) = 0.d0 - CALL addusstress_g (sigma_g ) + CALL addusstress_g( sigma_g ) ! sigmanlc = sigmanlc + sigma_g !WRITE (6,'(A)') 'addusstress_g' !WRITE (6,'(3f13.8)') sigma_g ELSE sigma_g(:,:) = 0.d0 - CALL addusstress_g (sigma_g ) + CALL addusstress_g( sigma_g ) sigmanlc = sigmanlc + sigma_g !WRITE (6,'(A)') 'addusstress_g' !WRITE (6,'(3f13.8)') sigma_g END IF ! END SUBROUTINE addusstress - +! !---------------------------------------------------------------------- -SUBROUTINE addusstress_g (sigmanlc) +SUBROUTINE addusstress_g( sigmanlc ) !---------------------------------------------------------------------- - ! - ! This routine computes the part of the crystal stress which is due - ! to the dependence of the Q function on the atomic position. - ! Adds contribution to input sigmanlc, does not sum contributions - ! from various processors (sum is performed by calling routine) - ! - USE kinds, ONLY : DP - USE ions_base, ONLY : nat, ntyp => nsp, ityp - USE cell_base, ONLY : omega, tpiba - USE fft_base, ONLY : dfftp - USE gvect, ONLY : ngm, gg, g, eigts1, eigts2, eigts3, mill - USE lsda_mod, ONLY : nspin - USE scf, ONLY : v, vltot - USE uspp, ONLY : becsum, okvan - USE uspp_param, ONLY : upf, lmaxq, nh, nhm - USE control_flags, ONLY : gamma_only - USE fft_interfaces,ONLY : fwfft - USE mp_pools, ONLY : inter_pool_comm - USE mp, ONLY : mp_sum + !! This routine computes the part of the crystal stress which is due + !! to the dependence of the Q function on the atomic position. + !! Adds contribution to input sigmanlc, does not sum contributions + !! from various processors (sum is performed by calling routine). + ! + USE kinds, ONLY : DP + USE ions_base, ONLY : nat, ntyp => nsp, ityp + USE cell_base, ONLY : omega, tpiba + USE fft_base, ONLY : dfftp + USE gvect, ONLY : ngm, gg, g, eigts1, eigts2, eigts3, mill + USE lsda_mod, ONLY : nspin + USE scf, ONLY : v, vltot + USE uspp, ONLY : becsum, okvan + USE uspp_param, ONLY : upf, lmaxq, nh, nhm + USE control_flags, ONLY : gamma_only + USE fft_interfaces, ONLY : fwfft + USE mp_pools, ONLY : inter_pool_comm + USE mp, ONLY : mp_sum ! IMPLICIT NONE ! - REAL(DP), INTENT(inout) :: sigmanlc (3, 3) - ! the nonlocal stress + REAL(DP), INTENT(INOUT) :: sigmanlc(3, 3) + !! the nonlocal stress + ! + ! ... local variables ! INTEGER :: ngm_s, ngm_e, ngm_l ! starting/ending indices, local number of G-vectors @@ -74,7 +82,7 @@ SUBROUTINE addusstress_g (sigmanlc) COMPLEX(DP), ALLOCATABLE :: aux(:), aux1(:,:), aux2(:,:), vg(:,:), qgm(:,:) ! work space (complex) COMPLEX(DP) :: cfac - REAL(dp) :: fac(3,nspin), sus(3,3) + REAL(DP) :: fac(3,nspin), sus(3,3) ! auxiliary variables REAL(DP) , ALLOCATABLE :: qmod(:), ylmk0(:,:), dylmk0(:,:), tbecsum(:,:) ! work space (real) @@ -84,38 +92,38 @@ SUBROUTINE addusstress_g (sigmanlc) ! ! fourier transform of the total effective potential ! - ALLOCATE ( vg(ngm,nspin)) - ALLOCATE ( aux(dfftp%nnr) ) + ALLOCATE( vg(ngm,nspin) ) + ALLOCATE( aux(dfftp%nnr) ) DO is = 1, nspin IF ( nspin == 4 .and. is /= 1 ) THEN aux(:) = v%of_r(:,is) ELSE aux(:) = vltot(:) + v%of_r(:,is) ENDIF - CALL fwfft ('Rho', aux, dfftp) + CALL fwfft( 'Rho', aux, dfftp ) DO ig = 1, ngm - vg (ig, is) = aux (dfftp%nl (ig) ) + vg(ig, is) = aux( dfftp%nl (ig) ) ENDDO ENDDO - DEALLOCATE ( aux ) + DEALLOCATE( aux ) ! ! With k-point parallelization, distribute G-vectors across processors ! ngm_s = index of first G-vector for this processor ! ngm_e = index of last G-vector for this processor ! ngm_l = local number of G-vectors ! - CALL divide (inter_pool_comm, ngm, ngm_s, ngm_e) + CALL divide( inter_pool_comm, ngm, ngm_s, ngm_e ) ngm_l = ngm_e-ngm_s+1 ! for the extraordinary unlikely case of more processors than G-vectors IF ( ngm_l <= 0 ) GO TO 10 ! - ALLOCATE ( aux1(ngm_l,3), aux2(ngm_l,nspin), qmod(ngm_l) ) - ALLOCATE ( ylmk0(ngm_l,lmaxq*lmaxq), dylmk0(ngm_l,lmaxq*lmaxq) ) + ALLOCATE( aux1(ngm_l,3), aux2(ngm_l,nspin), qmod(ngm_l) ) + ALLOCATE( ylmk0(ngm_l,lmaxq*lmaxq), dylmk0(ngm_l,lmaxq*lmaxq) ) ! - CALL ylmr2 (lmaxq * lmaxq, ngm_l, g(1,ngm_s), gg(ngm_s), ylmk0) + CALL ylmr2( lmaxq * lmaxq, ngm_l, g(1,ngm_s), gg(ngm_s), ylmk0 ) ! DO ig = 1, ngm_l - qmod (ig) = sqrt (gg (ngm_s+ig-1) ) + qmod(ig) = SQRT( gg(ngm_s+ig-1) ) ENDDO ! ! here we compute the integral Q*V for each atom, @@ -123,24 +131,24 @@ SUBROUTINE addusstress_g (sigmanlc) ! (no contribution from G=0) ! DO ipol = 1, 3 - CALL dylmr2 (lmaxq * lmaxq, ngm_l, g(1,ngm_s), gg(ngm_s), dylmk0, ipol) + CALL dylmr2( lmaxq * lmaxq, ngm_l, g(1,ngm_s), gg(ngm_s), dylmk0, ipol ) DO nt = 1, ntyp IF ( upf(nt)%tvanp ) THEN nij = nh(nt)*(nh(nt)+1)/2 - ALLOCATE (qgm(ngm_l,nij), tbecsum(nij,nspin) ) + ALLOCATE( qgm(ngm_l,nij), tbecsum(nij,nspin) ) ijh = 0 - DO ih = 1, nh (nt) - DO jh = ih, nh (nt) + DO ih = 1, nh(nt) + DO jh = ih, nh(nt) ijh = ijh + 1 - CALL dqvan2 (ih, jh, nt, ipol, ngm_l, g(1,ngm_s), qmod, & - ylmk0, dylmk0, qgm(1,ijh)) + CALL dqvan2( ih, jh, nt, ipol, ngm_l, g(1,ngm_s), qmod, & + ylmk0, dylmk0, qgm(1,ijh) ) ENDDO ENDDO ! DO na = 1, nat - IF (ityp (na) == nt) THEN + IF (ityp(na) == nt) THEN ! - tbecsum(:,:) = becsum(1:nij,na,1:nspin) + tbecsum(:,:) = becsum( 1:nij, na, 1:nspin ) ! CALL dgemm( 'N', 'N', 2*ngm_l, nspin, nij, 1.0_dp, & qgm, 2*ngm_l, tbecsum, nij, 0.0_dp, aux2, 2*ngm_l ) @@ -154,39 +162,38 @@ SUBROUTINE addusstress_g (sigmanlc) !$omp end parallel do !$omp parallel do default(shared) private(ig, cfac) DO ig = 1, ngm_l - cfac = CONJG( eigts1 (mill (1,ngm_s+ig-1), na) * & - eigts2 (mill (2,ngm_s+ig-1), na) * & - eigts3 (mill (3,ngm_s+ig-1), na) ) - aux1 (ig,1) = cfac * g (1,ngm_s+ig-1) - aux1 (ig,2) = cfac * g (2,ngm_s+ig-1) - aux1 (ig,3) = cfac * g (3,ngm_s+ig-1) + cfac = CONJG( eigts1(mill (1,ngm_s+ig-1), na) * & + eigts2(mill (2,ngm_s+ig-1), na) * & + eigts3(mill (3,ngm_s+ig-1), na) ) + aux1(ig,1) = cfac * g(1,ngm_s+ig-1) + aux1(ig,2) = cfac * g(2,ngm_s+ig-1) + aux1(ig,3) = cfac * g(3,ngm_s+ig-1) ENDDO !$omp end parallel do CALL DGEMM('T','N', 3, nspin, 2*ngm_l, 1.0_dp, aux1, 2*ngm_l, & aux2, 2*ngm_l, 0.0_dp, fac, 3 ) DO is = 1, nspin DO jpol = 1, 3 - sus (ipol, jpol) = sus (ipol, jpol) - omega * & - fac (jpol, is) + sus(ipol, jpol) = sus(ipol, jpol) - omega * fac(jpol, is) ENDDO ENDDO ENDIF ENDDO - DEALLOCATE ( tbecsum, qgm ) + DEALLOCATE( tbecsum, qgm ) ENDIF ENDDO ENDDO 10 CONTINUE - CALL mp_sum(sus,inter_pool_comm) + CALL mp_sum( sus, inter_pool_comm ) IF (gamma_only) THEN sigmanlc(:,:) = sigmanlc(:,:) + 2.0_dp*sus(:,:) ELSE sigmanlc(:,:) = sigmanlc(:,:) + sus(:,:) ENDIF - DEALLOCATE (ylmk0, dylmk0) - DEALLOCATE (aux1, aux2, vg, qmod) - + DEALLOCATE( ylmk0, dylmk0 ) + DEALLOCATE( aux1, aux2, vg, qmod ) + ! RETURN - + ! END SUBROUTINE addusstress_g From 27e900a4dcc568bcd581c3572e543f4bbafe899b Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Thu, 27 Jun 2019 11:23:22 +0200 Subject: [PATCH 32/95] Ford-PW part 2 --- PW/src/allocate_fft.f90 | 115 +++++++------- PW/src/allocate_locpot.f90 | 28 ++-- PW/src/allocate_nlpot.f90 | 79 +++++----- PW/src/allocate_wfc.f90 | 52 +++---- PW/src/atomic_wfc.f90 | 312 +++++++++++++++++++------------------ PW/src/atomic_wfc_mod.f90 | 23 +-- PW/src/average_pp.f90 | 62 ++++---- PW/src/bp_calc_btq.f90 | 56 +++---- 8 files changed, 370 insertions(+), 357 deletions(-) diff --git a/PW/src/allocate_fft.f90 b/PW/src/allocate_fft.f90 index 99a2dc7438..212b1daedb 100644 --- a/PW/src/allocate_fft.f90 +++ b/PW/src/allocate_fft.f90 @@ -9,77 +9,80 @@ !----------------------------------------------------------------------- SUBROUTINE allocate_fft !----------------------------------------------------------------------- + !! This routine allocates memory for FFT-related arrays. + !! IMPORTANT: routine "data_structure" must be called before it in + !! order to set the proper dimensions and grid distribution across + !! processors these dimensions. ! - ! This routine allocates memory for FFT-related arrays - IMPORTANT: - ! routine "data_structure" must be called before it in order to - ! set the proper dimensions and grid distribution across processors - ! these dimensions - ! - USE io_global, ONLY : stdout - USE gvect, ONLY : ngm, g, gg, mill, igtongl - USE gvecs, ONLY : ngms - USE fft_base, ONLY : dfftp, dffts - USE ions_base, ONLY : nat - USE lsda_mod, ONLY : nspin - USE spin_orb, ONLY : domag - USE scf, ONLY : rho, v, vnew, vltot, vrs, rho_core, rhog_core, & - kedtau, create_scf_type - USE control_flags, ONLY : gamma_only + USE io_global, ONLY : stdout + USE gvect, ONLY : ngm, g, gg, mill, igtongl + USE gvecs, ONLY : ngms + USE fft_base, ONLY : dfftp, dffts + USE ions_base, ONLY : nat + USE lsda_mod, ONLY : nspin + USE spin_orb, ONLY : domag + USE scf, ONLY : rho, v, vnew, vltot, vrs, rho_core, rhog_core, & + kedtau, create_scf_type + USE control_flags, ONLY : gamma_only USE noncollin_module, ONLY : pointlist, factlist, r_loc, & - report, i_cons, noncolin, npol - USE wavefunctions, ONLY : psic, psic_nc - USE funct, ONLY: dft_is_meta + report, i_cons, noncolin, npol + USE wavefunctions, ONLY : psic, psic_nc + USE funct, ONLY : dft_is_meta + ! IMPLICIT NONE ! - ! First a bunch of checks + ! ... First a bunch of checks ! - IF (dfftp%nnr.lt.ngm) THEN + IF (dfftp%nnr < ngm) THEN WRITE( stdout, '(/,4x," nr1=",i4," nr2= ", i4, " nr3=",i4, & &" nrxx = ",i8," ngm=",i8)') dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nnr, ngm - CALL errore ('allocate_fft', 'the nr"s are too small!', 1) - + CALL errore( 'allocate_fft', 'the nr"s are too small!', 1 ) + ! ENDIF - IF (dffts%nnr.lt.ngms) THEN + ! + IF (dffts%nnr < ngms) THEN WRITE( stdout, '(/,4x," nr1s=",i4," nr2s= ", i4, " nr3s=",i4, & &" nrxxs = ",i8," ngms=",i8)') dffts%nr1, dffts%nr2, dffts%nr3, dffts%nnr, ngms - CALL errore ('allocate_fft', 'the nrs"s are too small!', 1) - + CALL errore( 'allocate_fft', 'the nrs"s are too small!', 1 ) ENDIF - IF (ngm <= 0) CALL errore ('allocate_fft', 'wrong ngm', 1) - IF (ngms <= 0) CALL errore ('allocate_fft', 'wrong ngms', 1) - IF (dfftp%nnr <= 0) CALL errore ('allocate_fft', 'wrong nnr', 1) - IF (dffts%nnr<= 0) CALL errore ('allocate_fft', 'wrong smooth nnr', 1) - IF (nspin<= 0) CALL errore ('allocate_fft', 'wrong nspin', 1) ! - ! Allocate memory for all kind of stuff. + IF (ngm <= 0) CALL errore( 'allocate_fft', 'wrong ngm' , 1 ) + IF (ngms <= 0) CALL errore( 'allocate_fft', 'wrong ngms', 1 ) + IF (dfftp%nnr <= 0) CALL errore( 'allocate_fft', 'wrong nnr', 1 ) + IF (dffts%nnr<= 0) CALL errore( 'allocate_fft', 'wrong smooth nnr', 1 ) + IF (nspin<= 0) CALL errore( 'allocate_fft', 'wrong nspin', 1 ) + ! + ! ... Allocate memory for all kind of stuff. + ! + CALL create_scf_type( rho ) + CALL create_scf_type( v, do_not_allocate_becsum = .TRUE. ) + CALL create_scf_type( vnew, do_not_allocate_becsum = .TRUE. ) ! - CALL create_scf_type(rho) - CALL create_scf_type(v, do_not_allocate_becsum = .true.) - CALL create_scf_type(vnew, do_not_allocate_becsum = .true.) - ALLOCATE (vltot( dfftp%nnr)) - ALLOCATE (rho_core( dfftp%nnr)) - IF (dft_is_meta() ) THEN - ALLOCATE ( kedtau(dffts%nnr,nspin) ) + ALLOCATE( vltot(dfftp%nnr) ) + ALLOCATE( rho_core(dfftp%nnr) ) + IF ( dft_is_meta() ) THEN + ALLOCATE( kedtau(dffts%nnr,nspin) ) ELSE - ALLOCATE ( kedtau(1,nspin) ) + ALLOCATE( kedtau(1,nspin) ) ENDIF - ALLOCATE (rhog_core( ngm ) ) - ALLOCATE (psic( dfftp%nnr)) - ALLOCATE (vrs( dfftp%nnr, nspin)) - - IF (noncolin) ALLOCATE (psic_nc( dfftp%nnr, npol)) - - IF ( ( (report.ne.0).or.(i_cons.ne.0) ) .and. (noncolin.and.domag) & - .or. (i_cons.eq.1) .or. nspin==2 ) THEN -! -! In order to print out local quantities, integrated around the atoms, -! we need the following variables -! - ALLOCATE(pointlist(dfftp%nnr)) - ALLOCATE(factlist(dfftp%nnr)) - ALLOCATE(r_loc(nat)) - CALL make_pointlists ( ) + ALLOCATE( rhog_core(ngm) ) + ALLOCATE( psic(dfftp%nnr) ) + ALLOCATE( vrs(dfftp%nnr,nspin) ) + ! + IF (noncolin) ALLOCATE( psic_nc(dfftp%nnr,npol) ) + ! + IF ( ( (report /= 0).OR.(i_cons /= 0) ) .AND. (noncolin.AND.domag) & + .OR. (i_cons==1) .OR. nspin==2 ) THEN + ! + ! ... In order to print out local quantities, integrated around the atoms, + ! we need the following variables + ! + ALLOCATE( pointlist(dfftp%nnr) ) + ALLOCATE( factlist(dfftp%nnr) ) + ALLOCATE( r_loc(nat) ) + CALL make_pointlists( ) ENDIF - + ! RETURN + ! END SUBROUTINE allocate_fft diff --git a/PW/src/allocate_locpot.f90 b/PW/src/allocate_locpot.f90 index b887c60376..3f4c3faca6 100644 --- a/PW/src/allocate_locpot.f90 +++ b/PW/src/allocate_locpot.f90 @@ -7,26 +7,26 @@ ! ! !----------------------------------------------------------------------- -subroutine allocate_locpot +SUBROUTINE allocate_locpot !----------------------------------------------------------------------- - ! - ! dynamical allocation of arrays: - ! local potential for each kind of atom, structure factor + !! Dynamical allocation of arrays: + !! local potential for each kind of atom, structure factor ! USE ions_base, ONLY : nat, ntyp => nsp USE vlocal, ONLY : vloc, strf USE gvect, ONLY : eigts1, eigts2, eigts3, ngm, ngl USE fft_base , ONLY : dfftp ! - implicit none + IMPLICIT NONE ! - allocate (vloc( ngl, ntyp)) - allocate (strf( ngm, ntyp)) - - allocate( eigts1(-dfftp%nr1:dfftp%nr1,nat) ) - allocate( eigts2(-dfftp%nr2:dfftp%nr2,nat) ) - allocate( eigts3(-dfftp%nr3:dfftp%nr3,nat) ) - - return -end subroutine allocate_locpot + ALLOCATE( vloc( ngl, ntyp) ) + ALLOCATE( strf( ngm, ntyp) ) + ! + ALLOCATE( eigts1(-dfftp%nr1:dfftp%nr1,nat) ) + ALLOCATE( eigts2(-dfftp%nr2:dfftp%nr2,nat) ) + ALLOCATE( eigts3(-dfftp%nr3:dfftp%nr3,nat) ) + ! + RETURN + ! +END SUBROUTINE ALLOCATE_locpot diff --git a/PW/src/allocate_nlpot.f90 b/PW/src/allocate_nlpot.f90 index f518130afc..c14ccd9e5a 100644 --- a/PW/src/allocate_nlpot.f90 +++ b/PW/src/allocate_nlpot.f90 @@ -9,20 +9,18 @@ !----------------------------------------------------------------------- SUBROUTINE allocate_nlpot !----------------------------------------------------------------------- + !! This routine allocates arrays containing the non-local part of the + !! pseudopotential for each atom or atomic species. ! - ! This routine allocates arrays containing the non-local part of the - ! pseudopotential for each atom or atomic species + !! Requires in input: + !! * dimensions: nhm, nsp, nat, lmaxkb, nbetam, nspin + !! * pseudopot info: upf%nwfc + !! * parameters: gcutm, qnorm, dq, ecutwfc, cell_factor + !! * options: tqr, noncolin, lspinorb, spline_ps ! - ! Requires in input: - ! dimensions nhm, nsp, nat, lmaxkb, nbetam, nspin - ! pseudopot info upf%nwfc - ! parameters gcutm, qnorm, dq, ecutwfc, cell_factor - ! options tqr, noncolin, lspinorb, spline_ps - ! - ! Computes the following global quantities: - ! - ! nqx ! number of points of the interpolation table - ! nqxq ! as above, for q-function interpolation table + !! Computes the following global quantities: + !! * nqx: number of points of the interpolation table + !! * nqxq: as above, for q-function interpolation table ! USE control_flags, ONLY : tqr USE ions_base, ONLY : nat, nsp @@ -36,7 +34,7 @@ SUBROUTINE allocate_nlpot nqxq, spline_ps USE uspp, ONLY : indv, nhtol, nhtolm, ijtoh, qq_at, qq_nt, & dvan, deeq, indv_ijkb0, okvan, nhtoj, & - becsum, ebecsum, qq_so,dvan_so, deeq_nc + becsum, ebecsum, qq_so, dvan_so, deeq_nc USE uspp_param, ONLY : upf, lmaxq, lmaxkb, nh, nhm, nbetam USE spin_orb, ONLY : lspinorb, fcoef ! @@ -49,33 +47,33 @@ SUBROUTINE allocate_nlpot ! and the number of beta functions of the solid has been ! moved to init_run.f90 : pre_init() ! - ALLOCATE (indv( nhm, nsp)) - ALLOCATE (nhtol(nhm, nsp)) - ALLOCATE (nhtolm(nhm, nsp)) - ALLOCATE (nhtoj(nhm, nsp)) - ALLOCATE (ijtoh(nhm, nhm, nsp)) - ALLOCATE (indv_ijkb0(nat)) - ALLOCATE (deeq( nhm, nhm, nat, nspin)) - IF (noncolin) THEN - ALLOCATE (deeq_nc( nhm, nhm, nat, nspin)) + ALLOCATE( indv(nhm,nsp) ) + ALLOCATE( nhtol(nhm,nsp) ) + ALLOCATE( nhtolm(nhm,nsp) ) + ALLOCATE( nhtoj(nhm,nsp) ) + ALLOCATE( ijtoh(nhm,nhm,nsp) ) + ALLOCATE( indv_ijkb0(nat) ) + ALLOCATE( deeq(nhm,nhm,nat,nspin) ) + IF ( noncolin ) THEN + ALLOCATE( deeq_nc(nhm,nhm,nat,nspin) ) ENDIF - ALLOCATE (qq_at( nhm, nhm, nat)) - ALLOCATE (qq_nt( nhm, nhm, nsp)) - IF (lspinorb) THEN - ALLOCATE (qq_so(nhm, nhm, 4, nsp)) - ALLOCATE (dvan_so( nhm, nhm, nspin, nsp)) - ALLOCATE (fcoef(nhm,nhm,2,2,nsp)) + ALLOCATE( qq_at(nhm,nhm,nat) ) + ALLOCATE( qq_nt(nhm,nhm,nsp) ) + IF ( lspinorb ) THEN + ALLOCATE( qq_so(nhm,nhm,4,nsp) ) + ALLOCATE( dvan_so(nhm,nhm,nspin,nsp) ) + ALLOCATE( fcoef(nhm,nhm,2,2,nsp) ) ELSE - ALLOCATE (dvan( nhm, nhm, nsp)) + ALLOCATE( dvan(nhm,nhm,nsp) ) ENDIF ! GIPAW needs a slighly larger q-space interpolation for quantities calculated ! at k+q_gipaw, and I'm using the spline_ps=.true. flag to signal that - IF (spline_ps .and. cell_factor <= 1.1d0) cell_factor = 1.1d0 + IF ( spline_ps .AND. cell_factor <= 1.1d0 ) cell_factor = 1.1d0 ! ! This routine is called also by the phonon code, in which case it should ! allocate an array that includes q+G vectors up to |q+G|_max <= |Gmax|+|q| ! - nqxq = int( ( (sqrt(gcutm) + qnorm) / dq + 4) * cell_factor ) + nqxq = INT( ( (SQRT(gcutm) + qnorm) / dq + 4) * cell_factor ) lmaxq = 2*lmaxkb+1 ! IF (lmaxq > 0) ALLOCATE (qrad( nqxq, nbetam*(nbetam+1)/2, lmaxq, nsp)) @@ -85,15 +83,16 @@ SUBROUTINE allocate_nlpot ! Calculate dimensions for array tab (including a possible factor ! coming from cell contraction during variable cell relaxation/MD) ! - nqx = int( (sqrt (ecutwfc) / dq + 4) * cell_factor ) - - ALLOCATE (tab( nqx , nbetam , nsp)) - + nqx = INT( (SQRT(ecutwfc) / dq + 4) * cell_factor ) + ! + ALLOCATE( tab(nqx,nbetam,nsp) ) + ! ! d2y is for the cubic splines - IF (spline_ps) ALLOCATE (tab_d2y( nqx , nbetam , nsp)) - - nwfcm = maxval ( upf(1:nsp)%nwfc ) - ALLOCATE (tab_at( nqx , nwfcm , nsp)) - + IF (spline_ps) ALLOCATE( tab_d2y(nqx,nbetam,nsp) ) + ! + nwfcm = MAXVAL( upf(1:nsp)%nwfc ) + ALLOCATE( tab_at(nqx,nwfcm,nsp) ) + ! RETURN + ! END SUBROUTINE allocate_nlpot diff --git a/PW/src/allocate_wfc.f90 b/PW/src/allocate_wfc.f90 index 91c68ad984..00076a7ba5 100644 --- a/PW/src/allocate_wfc.f90 +++ b/PW/src/allocate_wfc.f90 @@ -9,69 +9,69 @@ !---------------------------------------------------------------------------- SUBROUTINE allocate_wfc() !---------------------------------------------------------------------------- - ! - ! ... dynamical allocation of arrays: wavefunctions - ! ... Requires dimensions: npwx, nbnd, npol,natomwfc, nwfcU - ! - USE io_global, ONLY : stdout - USE wvfct, ONLY : npwx, nbnd - USE basis, ONLY : natomwfc, swfcatom - USE fixed_occ, ONLY : one_atom_occupations - USE ldaU, ONLY : wfcU, nwfcU, lda_plus_u, U_projection - USE noncollin_module, ONLY : npol - USE wavefunctions, ONLY : evc - USE wannier_new, ONLY : use_wannier + !! Dynamical allocation of arrays: wavefunctions. + !! Requires dimensions: npwx, nbnd, npol, natomwfc, nwfcU + ! + USE io_global, ONLY : stdout + USE wvfct, ONLY : npwx, nbnd + USE basis, ONLY : natomwfc, swfcatom + USE fixed_occ, ONLY : one_atom_occupations + USE ldaU, ONLY : wfcU, nwfcU, lda_plus_u, U_projection + USE noncollin_module, ONLY : npol + USE wavefunctions, ONLY : evc + USE wannier_new, ONLY : use_wannier ! IMPLICIT NONE ! ! - ALLOCATE( evc( npwx*npol, nbnd ) ) + ALLOCATE( evc(npwx*npol,nbnd) ) IF ( one_atom_occupations .OR. use_wannier ) & - ALLOCATE( swfcatom( npwx*npol, natomwfc) ) + ALLOCATE( swfcatom(npwx*npol,natomwfc) ) IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) & - ALLOCATE( wfcU(npwx*npol, nwfcU) ) + ALLOCATE( wfcU(npwx*npol,nwfcU) ) ! RETURN ! END SUBROUTINE allocate_wfc ! +! !---------------------------------------------------------------------------- SUBROUTINE allocate_wfc_k() !---------------------------------------------------------------------------- - ! - ! ... dynamical allocation of k-point-dependent arrays: wavefunctions, betas - ! ... kinetic energy, k+G indices. Computes max no. of plane waves npwx and - ! ... k+G indices igk_k (needs G-vectors and cutoff gcutw) - ! ... Requires dimensions nbnd, npol, natomwfc, nwfcU - ! ... Requires that k-points are set up and distributed (if parallelized) + !! Dynamical allocation of k-point-dependent arrays: wavefunctions, betas + !! kinetic energy, k+G indices. Computes max no. of plane waves npwx and + !! k+G indices igk_k (needs G-vectors and cutoff gcutw). + !! Requires dimensions nbnd, npol, natomwfc, nwfcU. + !! Requires that k-points are set up and distributed (if parallelized). ! USE wvfct, ONLY : npwx, g2kin USE uspp, ONLY : vkb, nkb USE gvecw, ONLY : gcutw USE gvect, ONLY : ngm, g USE klist, ONLY : xk, nks, init_igk + ! IMPLICIT NONE ! INTEGER, EXTERNAL :: n_plane_waves ! ! calculate number of PWs for all kpoints ! - npwx = n_plane_waves (gcutw, nks, xk, g, ngm) + npwx = n_plane_waves( gcutw, nks, xk, g, ngm ) ! ! compute indices j=igk(i) such that (k+G)_i = k+G_j, for all k ! compute number of plane waves ngk(ik) as well ! - CALL init_igk ( npwx, ngm, g, gcutw ) + CALL init_igk( npwx, ngm, g, gcutw ) ! - CALL allocate_wfc ( ) + CALL allocate_wfc() ! ! beta functions ! - ALLOCATE ( vkb(npwx,nkb) ) + ALLOCATE( vkb(npwx,nkb) ) ! ! g2kin contains the kinetic energy \hbar^2(k+G)^2/2m ! - ALLOCATE ( g2kin(npwx) ) + ALLOCATE( g2kin(npwx) ) ! RETURN ! diff --git a/PW/src/atomic_wfc.f90 b/PW/src/atomic_wfc.f90 index 0ccf7b2047..ab22ae028e 100644 --- a/PW/src/atomic_wfc.f90 +++ b/PW/src/atomic_wfc.f90 @@ -7,85 +7,88 @@ ! ! !----------------------------------------------------------------------- -SUBROUTINE atomic_wfc (ik, wfcatom) +SUBROUTINE atomic_wfc( ik, wfcatom ) !----------------------------------------------------------------------- + !! This routine computes the superposition of atomic wavefunctions + !! for k-point "ik" - output in "wfcatom". ! - ! This routine computes the superposition of atomic wavefunctions - ! for k-point "ik" - output in "wfcatom" - ! - USE kinds, ONLY : DP - USE constants, ONLY : tpi, fpi, pi - USE cell_base, ONLY : omega, tpiba - USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau - USE basis, ONLY : natomwfc - USE gvect, ONLY : mill, eigts1, eigts2, eigts3, g - USE klist, ONLY : xk, igk_k, ngk - USE wvfct, ONLY : npwx - USE us, ONLY : tab_at, dq - USE uspp_param, ONLY : upf + USE kinds, ONLY : DP + USE constants, ONLY : tpi, fpi, pi + USE cell_base, ONLY : omega, tpiba + USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau + USE basis, ONLY : natomwfc + USE gvect, ONLY : mill, eigts1, eigts2, eigts3, g + USE klist, ONLY : xk, igk_k, ngk + USE wvfct, ONLY : npwx + USE us, ONLY : tab_at, dq + USE uspp_param, ONLY : upf USE noncollin_module, ONLY : noncolin, npol, angle1, angle2 - USE spin_orb, ONLY : lspinorb, rot_ylm, fcoef, lmaxx, domag, & - starting_spin_angle - USE mp_bands, ONLY : inter_bgrp_comm - USE mp, ONLY : mp_sum + USE spin_orb, ONLY : lspinorb, rot_ylm, fcoef, lmaxx, domag, & + starting_spin_angle + USE mp_bands, ONLY : inter_bgrp_comm + USE mp, ONLY : mp_sum + ! + IMPLICIT NONE ! - implicit none + INTEGER, INTENT(IN) :: ik + !! k-point index + COMPLEX(DP), INTENT(OUT) :: wfcatom( npwx, npol, natomwfc ) + !! Superposition of atomic wavefunctions ! - integer, intent(in) :: ik - complex(DP), intent(out) :: wfcatom (npwx, npol, natomwfc) + ! ... local variables ! - integer :: n_starting_wfc, lmax_wfc, nt, l, nb, na, m, lm, ig, iig, & + INTEGER :: n_starting_wfc, lmax_wfc, nt, l, nb, na, m, lm, ig, iig, & i0, i1, i2, i3, nwfcm, npw - real(DP), allocatable :: qg(:), ylm (:,:), chiq (:,:,:), gk (:,:) - complex(DP), allocatable :: sk (:), aux(:) - complex(DP) :: kphase, lphase - real(DP) :: arg, px, ux, vx, wx - integer :: ig_start, ig_end + REAL(DP), ALLOCATABLE :: qg(:), ylm (:,:), chiq (:,:,:), gk (:,:) + COMPLEX(DP), ALLOCATABLE :: sk (:), aux(:) + COMPLEX(DP) :: kphase, lphase + REAL(DP) :: arg, px, ux, vx, wx + INTEGER :: ig_start, ig_end - call start_clock ('atomic_wfc') + CALL start_clock( 'atomic_wfc' ) ! calculate max angular momentum required in wavefunctions lmax_wfc = 0 - do nt = 1, ntyp - lmax_wfc = MAX ( lmax_wfc, MAXVAL (upf(nt)%lchi(1:upf(nt)%nwfc) ) ) - enddo + DO nt = 1, ntyp + lmax_wfc = MAX( lmax_wfc, MAXVAL( upf(nt)%lchi(1:upf(nt)%nwfc) ) ) + END DO ! - nwfcm = MAXVAL ( upf(1:ntyp)%nwfc ) + nwfcm = MAXVAL( upf(1:ntyp)%nwfc ) npw = ngk(ik) ! - allocate ( ylm (npw,(lmax_wfc+1)**2), chiq(npw,nwfcm,ntyp), & + ALLOCATE( ylm (npw,(lmax_wfc+1)**2), chiq(npw,nwfcm,ntyp), & sk(npw), gk(3,npw), qg(npw) ) ! - do ig = 1, npw + DO ig = 1, npw iig = igk_k (ig,ik) gk (1,ig) = xk(1, ik) + g(1,iig) gk (2,ig) = xk(2, ik) + g(2,iig) gk (3,ig) = xk(3, ik) + g(3,iig) qg(ig) = gk(1, ig)**2 + gk(2, ig)**2 + gk(3, ig)**2 - enddo + END DO ! ! ylm = spherical harmonics ! - call ylmr2 ((lmax_wfc+1)**2, npw, gk, qg, ylm) + CALL ylmr2( (lmax_wfc+1)**2, npw, gk, qg, ylm ) ! from now to the end of the routine the ig loops are distributed across bgrp - call divide(inter_bgrp_comm,npw,ig_start,ig_end) + CALL divide( inter_bgrp_comm,npw,ig_start,ig_end ) ! ! set now q=|k+G| in atomic units ! - do ig = ig_start, ig_end - qg(ig) = sqrt(qg(ig))*tpiba - enddo + DO ig = ig_start, ig_end + qg(ig) = SQRT( qg(ig) )*tpiba + END DO ! n_starting_wfc = 0 ! ! chiq = radial fourier transform of atomic orbitals chi ! - do nt = 1, ntyp - do nb = 1, upf(nt)%nwfc - if ( upf(nt)%oc (nb) >= 0.d0) then - do ig = ig_start, ig_end - px = qg (ig) / dq - int (qg (ig) / dq) + DO nt = 1, ntyp + DO nb = 1, upf(nt)%nwfc + IF ( upf(nt)%oc (nb) >= 0.d0 ) THEN + DO ig = ig_start, ig_end + px = qg (ig) / dq - INT(qg (ig) / dq) ux = 1.d0 - px vx = 2.d0 - px wx = 3.d0 - px @@ -98,32 +101,32 @@ SUBROUTINE atomic_wfc (ik, wfcatom) tab_at (i1, nb, nt) * px * vx * wx / 2.d0 - & tab_at (i2, nb, nt) * px * ux * wx / 2.d0 + & tab_at (i3, nb, nt) * px * ux * vx / 6.d0 - enddo - endif - enddo - enddo + END DO + END IF + END DO + END DO - deallocate (qg, gk) - allocate ( aux(npw) ) + DEALLOCATE( qg, gk ) + ALLOCATE( aux(npw) ) ! wfcatom(:,:,:) = (0.0_dp, 0.0_dp) ! - do na = 1, nat + DO na = 1, nat arg = (xk(1,ik)*tau(1,na) + xk(2,ik)*tau(2,na) + xk(3,ik)*tau(3,na)) * tpi - kphase = CMPLX(cos (arg), - sin (arg) ,kind=DP) + kphase = CMPLX( COS(arg), - SIN(arg) ,KIND=DP) ! ! sk is the structure factor ! - do ig = ig_start, ig_end + DO ig = ig_start, ig_end iig = igk_k (ig,ik) sk (ig) = kphase * eigts1 (mill (1,iig), na) * & eigts2 (mill (2,iig), na) * & eigts3 (mill (3,iig), na) - enddo + END DO ! nt = ityp (na) - do nb = 1, upf(nt)%nwfc - if (upf(nt)%oc(nb) >= 0.d0) then + DO nb = 1, upf(nt)%nwfc + IF ( upf(nt)%oc(nb) >= 0.d0 ) THEN l = upf(nt)%lchi(nb) lphase = (0.d0,1.d0)**l ! @@ -134,21 +137,21 @@ SUBROUTINE atomic_wfc (ik, wfcatom) ! IF ( upf(nt)%has_so ) THEN ! - IF (starting_spin_angle.OR..not.domag) THEN - call atomic_wfc_so ( ) + IF (starting_spin_angle.OR..NOT.domag) THEN + CALL atomic_wfc_so( ) ELSE - call atomic_wfc_so_mag ( ) - ENDIF + CALL atomic_wfc_so_mag( ) + END IF ! ELSE ! - call atomic_wfc_nc ( ) + CALL atomic_wfc_nc( ) ! - ENDIF + END IF ! ELSE ! - call atomic_wfc___ ( ) + CALL atomic_wfc___( ) ! END IF ! @@ -158,34 +161,34 @@ SUBROUTINE atomic_wfc (ik, wfcatom) ! END DO - if (n_starting_wfc /= natomwfc) call errore ('atomic_wfc', & - 'internal error: some wfcs were lost ', 1) + IF ( n_starting_wfc /= natomwfc) call errore ('atomic_wfc', & + 'internal error: some wfcs were lost ', 1 ) - deallocate(aux, sk, chiq, ylm) + DEALLOCATE( aux, sk, chiq, ylm ) ! collect results across bgrp - call mp_sum(wfcatom, inter_bgrp_comm) + CALL mp_sum( wfcatom, inter_bgrp_comm ) - call stop_clock ('atomic_wfc') - return + CALL stop_clock( 'atomic_wfc' ) + RETURN CONTAINS - - SUBROUTINE atomic_wfc_so ( ) - ! - ! ... spin-orbit case +!---------------------------------------------------------------- + SUBROUTINE atomic_wfc_so( ) + !------------------------------------------------------------ + !! Spin-orbit case. ! - real(DP) :: fact(2), j - real(DP), external :: spinor - integer :: ind, ind1, n1, is, sph_ind + REAL(DP) :: fact(2), j + REAL(DP), EXTERNAL :: spinor + INTEGER :: ind, ind1, n1, is, sph_ind ! j = upf(nt)%jchi(nb) - do m = -l-1, l + DO m = -l-1, l fact(1) = spinor(l,j,m,1) fact(2) = spinor(l,j,m,2) - if (abs(fact(1)) > 1.d-8 .or. abs(fact(2)) > 1.d-8) then + IF ( ABS(fact(1)) > 1.d-8 .OR. ABS(fact(2)) > 1.d-8 ) THEN n_starting_wfc = n_starting_wfc + 1 - if (n_starting_wfc > natomwfc) call errore & + IF (n_starting_wfc > natomwfc) CALL errore & ('atomic_wfc_so', 'internal error: too many wfcs', 1) DO is=1,2 IF (abs(fact(is)) > 1.d-8) THEN @@ -197,11 +200,11 @@ SUBROUTINE atomic_wfc_so ( ) aux(:)=aux(:)+rot_ylm(ind,n1)*ylm(:,ind1) ENDDO do ig = ig_start, ig_end - wfcatom (ig,is,n_starting_wfc) = lphase*fact(is)*& + wfcatom(ig,is,n_starting_wfc) = lphase*fact(is)*& sk(ig)*aux(ig)*chiq (ig, nb, nt) END DO ELSE - wfcatom (:,is,n_starting_wfc) = (0.d0,0.d0) + wfcatom(:,is,n_starting_wfc) = (0.d0,0.d0) END IF END DO END IF @@ -209,31 +212,31 @@ SUBROUTINE atomic_wfc_so ( ) ! END SUBROUTINE atomic_wfc_so ! - SUBROUTINE atomic_wfc_so_mag ( ) + SUBROUTINE atomic_wfc_so_mag( ) ! - ! ... spin-orbit case, magnetization along "angle1" and "angle2" - ! In the magnetic case we always assume that magnetism is much larger - ! than spin-orbit and average the wavefunctions at l+1/2 and l-1/2 - ! filling then the up and down spinors with the average wavefunctions, - ! according to the direction of the magnetization, following what is - ! done in the noncollinear case + !! Spin-orbit case, magnetization along "angle1" and "angle2" + !! In the magnetic case we always assume that magnetism is much larger + !! than spin-orbit and average the wavefunctions at l+1/2 and l-1/2 + !! filling then the up and down spinors with the average wavefunctions, + !! according to the direction of the magnetization, following what is + !! done in the noncollinear case. ! - real(DP) :: alpha, gamman, j - complex(DP) :: fup, fdown - real(DP), ALLOCATABLE :: chiaux(:) - integer :: nc, ib + REAL(DP) :: alpha, gamman, j + COMPLEX(DP) :: fup, fdown + REAL(DP), ALLOCATABLE :: chiaux(:) + INTEGER :: nc, ib ! j = upf(nt)%jchi(nb) -! -! This routine creates two functions only in the case j=l+1/2 or exit in the -! other case -! + ! + ! This routine creates two functions only in the case j=l+1/2 or exit in the + ! other case + ! IF (ABS(j-l+0.5_DP)<1.d-4) RETURN ALLOCATE(chiaux(npw)) -! -! Find the functions j=l-1/2 -! + ! + ! Find the functions j=l-1/2 + ! IF (l == 0) THEN chiaux(:)=chiq(:,nb,nt) ELSE @@ -244,51 +247,52 @@ SUBROUTINE atomic_wfc_so_mag ( ) EXIT ENDIF ENDDO -! -! Average the two functions -! + ! + ! Average the two functions + ! chiaux(:)=(chiq(:,nb,nt)*(l+1.0_DP)+chiq(:,nc,nt)*l)/(2.0_DP*l+1.0_DP) - ENDIF -! -! and construct the starting wavefunctions as in the noncollinear case. -! + ! + ENDIF + ! + ! and construct the starting wavefunctions as in the noncollinear case. + ! alpha = angle1(nt) gamman = - angle2(nt) + 0.5d0*pi ! DO m = 1, 2 * l + 1 lm = l**2 + m n_starting_wfc = n_starting_wfc + 1 - if (n_starting_wfc + 2*l+1 > natomwfc) call errore & + IF ( n_starting_wfc + 2*l+1 > natomwfc ) CALL errore & ('atomic_wfc_nc', 'internal error: too many wfcs', 1) - do ig = ig_start, ig_end + DO ig = ig_start, ig_end aux(ig) = sk(ig)*ylm(ig,lm)*chiaux(ig) END DO -! -! now, rotate wfc as needed -! first : rotation with angle alpha around (OX) -! - do ig = ig_start, ig_end + ! + ! now, rotate wfc as needed + ! first : rotation with angle alpha around (OX) + ! + DO ig = ig_start, ig_end fup = cos(0.5d0*alpha)*aux(ig) fdown = (0.d0,1.d0)*sin(0.5d0*alpha)*aux(ig) -! -! Now, build the orthogonal wfc -! first rotation with angle (alpha+pi) around (OX) -! + ! + ! Now, build the orthogonal wfc + ! first rotation with angle (alpha+pi) around (OX) + ! wfcatom(ig,1,n_starting_wfc) = (cos(0.5d0*gamman) & +(0.d0,1.d0)*sin(0.5d0*gamman))*fup wfcatom(ig,2,n_starting_wfc) = (cos(0.5d0*gamman) & -(0.d0,1.d0)*sin(0.5d0*gamman))*fdown -! -! second: rotation with angle gamma around (OZ) -! -! Now, build the orthogonal wfc -! first rotation with angle (alpha+pi) around (OX) -! + ! + ! second: rotation with angle gamma around (OZ) + ! + ! Now, build the orthogonal wfc + ! first rotation with angle (alpha+pi) around (OX) + ! fup = cos(0.5d0*(alpha+pi))*aux(ig) fdown = (0.d0,1.d0)*sin(0.5d0*(alpha+pi))*aux(ig) -! -! second, rotation with angle gamma around (OZ) -! + ! + ! second, rotation with angle gamma around (OZ) + ! wfcatom(ig,1,n_starting_wfc+2*l+1) = (cos(0.5d0*gamman) & +(0.d0,1.d0)*sin(0.5d0 *gamman))*fup wfcatom(ig,2,n_starting_wfc+2*l+1) = (cos(0.5d0*gamman) & @@ -296,16 +300,16 @@ SUBROUTINE atomic_wfc_so_mag ( ) END DO END DO n_starting_wfc = n_starting_wfc + 2*l+1 - DEALLOCATE(chiaux) + DEALLOCATE( chiaux ) ! END SUBROUTINE atomic_wfc_so_mag ! - SUBROUTINE atomic_wfc_nc ( ) + SUBROUTINE atomic_wfc_nc( ) ! - ! ... noncolinear case, magnetization along "angle1" and "angle2" + !! noncolinear case, magnetization along "angle1" and "angle2" ! - real(DP) :: alpha, gamman - complex(DP) :: fup, fdown + REAL(DP) :: alpha, gamman + COMPLEX(DP) :: fup, fdown ! alpha = angle1(nt) gamman = - angle2(nt) + 0.5d0*pi @@ -313,37 +317,37 @@ SUBROUTINE atomic_wfc_nc ( ) DO m = 1, 2 * l + 1 lm = l**2 + m n_starting_wfc = n_starting_wfc + 1 - if (n_starting_wfc + 2*l+1 > natomwfc) call errore & + IF ( n_starting_wfc + 2*l+1 > natomwfc) CALL errore & ('atomic_wfc_nc', 'internal error: too many wfcs', 1) - do ig = ig_start, ig_end + DO ig = ig_start, ig_end aux(ig) = sk(ig)*ylm(ig,lm)*chiq(ig,nb,nt) END DO -! -! now, rotate wfc as needed -! first : rotation with angle alpha around (OX) -! - do ig = ig_start, ig_end + ! + ! now, rotate wfc as needed + ! first : rotation with angle alpha around (OX) + ! + DO ig = ig_start, ig_end fup = cos(0.5d0*alpha)*aux(ig) fdown = (0.d0,1.d0)*sin(0.5d0*alpha)*aux(ig) -! -! Now, build the orthogonal wfc -! first rotation with angle (alpha+pi) around (OX) -! + ! + ! Now, build the orthogonal wfc + ! first rotation with angle (alpha+pi) around (OX) + ! wfcatom(ig,1,n_starting_wfc) = (cos(0.5d0*gamman) & +(0.d0,1.d0)*sin(0.5d0*gamman))*fup wfcatom(ig,2,n_starting_wfc) = (cos(0.5d0*gamman) & -(0.d0,1.d0)*sin(0.5d0*gamman))*fdown -! -! second: rotation with angle gamma around (OZ) -! -! Now, build the orthogonal wfc -! first rotation with angle (alpha+pi) around (OX) -! + ! + ! second: rotation with angle gamma around (OZ) + ! + ! Now, build the orthogonal wfc + ! first rotation with angle (alpha+pi) around (OX) + ! fup = cos(0.5d0*(alpha+pi))*aux(ig) fdown = (0.d0,1.d0)*sin(0.5d0*(alpha+pi))*aux(ig) -! -! second, rotation with angle gamma around (OZ) -! + ! + ! second, rotation with angle gamma around (OZ) + ! wfcatom(ig,1,n_starting_wfc+2*l+1) = (cos(0.5d0*gamman) & +(0.d0,1.d0)*sin(0.5d0 *gamman))*fup wfcatom(ig,2,n_starting_wfc+2*l+1) = (cos(0.5d0*gamman) & @@ -361,10 +365,10 @@ SUBROUTINE atomic_wfc___( ) DO m = 1, 2 * l + 1 lm = l**2 + m n_starting_wfc = n_starting_wfc + 1 - if (n_starting_wfc > natomwfc) call errore & + IF ( n_starting_wfc > natomwfc) CALL errore & ('atomic_wfc___', 'internal error: too many wfcs', 1) ! - do ig = ig_start, ig_end + DO ig = ig_start, ig_end wfcatom (ig, 1, n_starting_wfc) = lphase * & sk (ig) * ylm (ig, lm) * chiq (ig, nb, nt) ENDDO diff --git a/PW/src/atomic_wfc_mod.f90 b/PW/src/atomic_wfc_mod.f90 index 7321566f7a..603d4037e1 100644 --- a/PW/src/atomic_wfc_mod.f90 +++ b/PW/src/atomic_wfc_mod.f90 @@ -9,18 +9,21 @@ ! MODULE basis ! - ! ... The variables needed to describe atomic wavefunctions + !! The variables needed to describe the atomic wavefunctions. + ! + USE kinds, ONLY : DP ! - USE kinds, ONLY : dp SAVE ! - INTEGER :: & - natomwfc ! number of (starting) atomic wavefunctions - COMPLEX(dp), ALLOCATABLE :: & - swfcatom(:,:) ! S * (starting) atomic wavefunctions - CHARACTER(len=30) :: &! - starting_wfc, &! 'random','atomic','file','atomic+random' (default) - starting_pot, &! 'atomic' or 'file' - startingconfig ! 'input' or 'file' + INTEGER :: natomwfc + !! number of (starting) atomic wavefunctions + COMPLEX(DP), ALLOCATABLE :: swfcatom(:,:) + !! S * (starting) atomic wavefunctions + CHARACTER(len=30) :: starting_wfc + !! It can be: 'random', 'atomic', 'file', 'atomic+random' (default) + CHARACTER(len=30) :: starting_pot + !! It can be 'atomic' or 'file' + CHARACTER(len=30) :: startingconfig + !! It can be 'input' or 'file' ! END MODULE basis diff --git a/PW/src/average_pp.f90 b/PW/src/average_pp.f90 index b5b49a79a6..b2bbbb5904 100644 --- a/PW/src/average_pp.f90 +++ b/PW/src/average_pp.f90 @@ -6,8 +6,9 @@ ! or http://www.gnu.org/copyleft/gpl.txt . ! !---------------------------------------------------------------------------- -SUBROUTINE average_pp ( ntyp ) +SUBROUTINE average_pp( ntyp ) !---------------------------------------------------------------------------- + !! Spin-orbit pseudopotentials transformed into standard pseudopotentials. ! USE kinds, ONLY : DP USE atom, ONLY : rgrid @@ -16,8 +17,11 @@ SUBROUTINE average_pp ( ntyp ) IMPLICIT NONE ! INTEGER, INTENT(IN) :: ntyp + !! number of species ! - INTEGER :: nt, nb, nbe, ind, ind1, l + ! ... local variables + ! + INTEGER :: nt, nb, nbe, ind, ind1, l REAL(DP) :: vionl ! ! @@ -37,7 +41,7 @@ SUBROUTINE average_pp ( ntyp ) IF ( upf(nt)%lll(nb) /= 0 .AND. & ABS( upf(nt)%jjj(nb) - upf(nt)%lll(nb) - 0.5D0 ) < 1.D-7 ) & nbe = nbe - 1 - END DO + ENDDO ! upf(nt)%nbeta = nbe ! @@ -53,22 +57,22 @@ SUBROUTINE average_pp ( ntyp ) ! IF (ABS(upf(nt)%jjj(nbe)-upf(nt)%lll(nbe)+0.5d0) < 1.d-7) THEN IF ( ABS( upf(nt)%jjj(nbe+1)-upf(nt)%lll(nbe+1)-0.5d0 ) & - > 1.d-7 ) call errore('average_pp','wrong beta functions',1) - ind=nbe+1 - ind1=nbe + > 1.d-7 ) CALL errore( 'average_pp', 'wrong beta functions', 1 ) + ind = nbe+1 + ind1 = nbe ELSE IF (ABS(upf(nt)%jjj(nbe+1)-upf(nt)%lll(nbe+1)+0.5d0) > 1.d-7) & - call errore('average_pp','wrong beta functions',2) - ind=nbe - ind1=nbe+1 + CALL errore( 'average_pp', 'wrong beta functions', 2 ) + ind = nbe + ind1 = nbe+1 ENDIF ! vionl = ( ( l + 1.D0 ) * upf(nt)%dion(ind,ind) + & - l * upf(nt)%dion(ind1,ind1) ) / ( 2.D0 * l + 1.D0 ) + l * upf(nt)%dion(ind1,ind1) ) / ( 2.D0 * l + 1.D0 ) ! upf(nt)%beta(1:rgrid(nt)%mesh,nb) = 1.D0 / ( 2.D0 * l + 1.D0 ) * & - ( ( l + 1.D0 ) * SQRT( upf(nt)%dion(ind,ind) / vionl ) * & - upf(nt)%beta(1:rgrid(nt)%mesh,ind) + & + ( ( l + 1.D0 ) * SQRT( upf(nt)%dion(ind,ind) / vionl ) * & + upf(nt)%beta(1:rgrid(nt)%mesh,ind) + & l * SQRT( upf(nt)%dion(ind1,ind1) / vionl ) * & upf(nt)%beta(1:rgrid(nt)%mesh,ind1) ) ! @@ -83,11 +87,11 @@ SUBROUTINE average_pp ( ntyp ) ! upf(nt)%dion(nb,nb) = upf(nt)%dion(nbe,nbe) ! - END IF + ENDIF ! - upf(nt)%lll(nb)=upf(nt)%lll(nbe) + upf(nt)%lll(nb) = upf(nt)%lll(nbe) ! - END DO + ENDDO ! nbe = 0 ! @@ -99,13 +103,13 @@ SUBROUTINE average_pp ( ntyp ) ABS(upf(nt)%jchi(nb)-upf(nt)%lchi(nb)-0.5D0 ) < 1.D-7 ) & nbe = nbe - 1 ! - END DO + ENDDO ! upf(nt)%nwfc = nbe ! nbe = 0 ! - do nb = 1, upf(nt)%nwfc + DO nb = 1, upf(nt)%nwfc ! nbe = nbe + 1 ! @@ -115,15 +119,15 @@ SUBROUTINE average_pp ( ntyp ) ! IF (ABS(upf(nt)%jchi(nbe)-upf(nt)%lchi(nbe)+0.5d0) < 1.d-7) THEN IF ( ABS(upf(nt)%jchi(nbe+1)-upf(nt)%lchi(nbe+1)-0.5d0) > & - 1.d-7) call errore('average_pp','wrong chi functions',3) - ind=nbe+1 - ind1=nbe + 1.d-7) CALL errore( 'average_pp', 'wrong chi functions', 3 ) + ind = nbe+1 + ind1 = nbe ELSE IF ( ABS(upf(nt)%jchi(nbe+1)-upf(nt)%lchi(nbe+1)+0.5d0) > & - 1.d-7) call errore('average_pp','wrong chi functions',4) - ind=nbe - ind1=nbe+1 - END IF + 1.d-7) CALL errore( 'average_pp', 'wrong chi functions', 4 ) + ind = nbe + ind1 = nbe+1 + ENDIF ! upf(nt)%chi(1:rgrid(nt)%mesh,nb) = & ((l+1.D0) * upf(nt)%chi(1:rgrid(nt)%mesh,ind)+ & @@ -135,16 +139,16 @@ SUBROUTINE average_pp ( ntyp ) ! upf(nt)%chi(1:rgrid(nt)%mesh,nb) = upf(nt)%chi(1:rgrid(nt)%mesh,nbe) ! - END IF + ENDIF ! - upf(nt)%lchi(nb)= upf(nt)%lchi(nbe) + upf(nt)%lchi(nb) = upf(nt)%lchi(nbe) ! - END DO + ENDDO ! - END IF + ENDIF ! upf(nt)%has_so = .FALSE. ! - END DO + ENDDO ! END SUBROUTINE average_pp diff --git a/PW/src/bp_calc_btq.f90 b/PW/src/bp_calc_btq.f90 index 70014c9c46..e35fc0ea3c 100644 --- a/PW/src/bp_calc_btq.f90 +++ b/PW/src/bp_calc_btq.f90 @@ -6,19 +6,18 @@ ! or http://www.gnu.org/copyleft/gpl.txt . ! !---------------------------------------------------------------------- -SUBROUTINE calc_btq(ql,qr_k,idbes) +SUBROUTINE calc_btq( ql, qr_k, idbes ) !---------------------------------------------------------------------- + !! Calculates the Bessel-transform (or its derivative if idbes=1) + !! of the augmented qrad charges at a given ql point. + !! Rydberg atomic units are used. ! - ! Calculates the Bessel-transform (or its derivative if idbes=1) - ! of the augmented qrad charges at a given ql point. - ! Rydberg atomic units are used. - ! - USE kinds, ONLY: DP - USE atom, ONLY: rgrid - USE ions_base, ONLY : ntyp => nsp - USE cell_base, ONLY: omega - USE constants, ONLY: fpi - USE uspp_param, ONLY: upf, nbetam, lmaxq + USE kinds, ONLY: DP + USE atom, ONLY: rgrid + USE ions_base, ONLY: ntyp => nsp + USE cell_base, ONLY: omega + USE constants, ONLY: fpi + USE uspp_param, ONLY: upf, nbetam, lmaxq ! IMPLICIT NONE ! @@ -29,20 +28,20 @@ SUBROUTINE calc_btq(ql,qr_k,idbes) REAL(DP) :: qrk REAL(DP), ALLOCATABLE :: jl(:), aux(:) ! - DO np=1,ntyp + DO np = 1, ntyp ! IF ( upf(np)%tvanp ) THEN ! - ALLOCATE ( jl(upf(np)%kkbeta), aux(upf(np)%kkbeta) ) - DO iv =1, upf(np)%nbeta - DO jv =iv, upf(np)%nbeta + ALLOCATE( jl(upf(np)%kkbeta), aux(upf(np)%kkbeta) ) + DO iv = 1, upf(np)%nbeta + DO jv = iv, upf(np)%nbeta ijv = jv * (jv-1) / 2 + iv - ilmin = abs ( upf(np)%lll(iv) - upf(np)%lll(jv) ) - ilmax = upf(np)%lll(iv) + upf(np)%lll(jv) + ilmin = ABS( upf(np)%lll(iv) - upf(np)%lll(jv) ) + ilmax = upf(np)%lll(iv) + upf(np)%lll(jv) ! only need to calculate for l=lmin,lmin+2 ...lmax-2,lmax DO l = ilmin,ilmax,2 aux(:) = 0.0_DP - aux(1:upf(np)%kkbeta) = upf(np)%qfuncl(1:upf(np)%kkbeta,ijv,l) + aux(1:upf(np)%kkbeta) = upf(np)%qfuncl(1:upf(np)%kkbeta,ijv,l) IF (idbes == 1) THEN ! CALL sph_dbes( upf(np)%kkbeta, rgrid(np)%r, ql, l, jl ) @@ -52,25 +51,26 @@ SUBROUTINE calc_btq(ql,qr_k,idbes) CALL sph_bes( upf(np)%kkbeta, rgrid(np)%r, ql, l, jl ) ! ENDIF - + ! ! jl is the Bessel function (or its derivative) calculated at ql ! now integrate qfunc*jl*r^2 = Bessel transform of qfunc - - DO i=1, upf(np)%kkbeta + ! + DO i = 1, upf(np)%kkbeta aux(i) = jl(i)*aux(i) ENDDO ! if (tlog(np)) then - CALL simpson(upf(np)%kkbeta,aux,rgrid(np)%rab,qrk) - - qr_k(iv,jv,l+1,np) = qrk*fpi/omega + CALL simpson( upf(np)%kkbeta, aux, rgrid(np)%rab, qrk ) + ! + qr_k(iv,jv,l+1,np) = qrk * fpi / omega qr_k(jv,iv,l+1,np) = qr_k(iv,jv,l+1,np) - - END DO - END DO + ! + ENDDO + ENDDO ENDDO - DEALLOCATE ( aux, jl ) + DEALLOCATE( aux, jl ) ENDIF ENDDO ! RETURN + ! END SUBROUTINE calc_btq From 1df8428b001e4c247c491970a157451463976fdf Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Thu, 27 Jun 2019 15:44:57 +0200 Subject: [PATCH 33/95] Ford-PW part 3 --- PW/src/bp_mod.f90 | 316 +++++++++++++++++++++----------------- PW/src/bp_qvan3.f90 | 122 +++++++++------ PW/src/bp_strings.f90 | 51 +++--- PW/src/buffers.f90 | 204 ++++++++++++------------ PW/src/c_bands.f90 | 294 ++++++++++++++++++----------------- PW/src/cdiagh.f90 | 20 +-- PW/src/clean_pw.f90 | 98 ++++++------ PW/src/close_files.f90 | 57 +++---- PW/src/compute_becsum.f90 | 35 ++--- PW/src/compute_deff.f90 | 170 +++++++++++--------- 10 files changed, 739 insertions(+), 628 deletions(-) diff --git a/PW/src/bp_mod.f90 b/PW/src/bp_mod.f90 index d9163917ab..73879cfd77 100644 --- a/PW/src/bp_mod.f90 +++ b/PW/src/bp_mod.f90 @@ -5,175 +5,209 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! -!-------------------------------------------------------------------------- -! +!--------------------------------------------------------------------------------- MODULE bp +!--------------------------------------------------------------------------------- + !! Contains the variables needed for the Berry phase polarization calculation ! - ! ... The variables needed for the Berry phase polarization calculation - ! - USE kinds, ONLY: DP - USE becmod, ONLY : bec_type + USE kinds, ONLY: DP + USE becmod, ONLY: bec_type ! SAVE PRIVATE - PUBLIC:: lberry, lelfield, lorbm, gdir, nppstr, nberrycyc, evcel, evcelp, evcelm, & - fact_hepsi, bec_evcel, mapgp_global, mapgm_global, nppstr_3d, & - ion_pol, el_pol, fc_pol, l_el_pol_old, el_pol_old, el_pol_acc, & - nx_el, l3dstring, efield, efield_cart, efield_cry, transform_el,& - mapg_owner, phase_control + PUBLIC :: lberry, lelfield, lorbm, gdir, nppstr, nberrycyc, evcel, evcelp, evcelm, & + fact_hepsi, bec_evcel, mapgp_global, mapgm_global, nppstr_3d, ion_pol, & + el_pol, fc_pol, l_el_pol_old, el_pol_old, el_pol_acc, nx_el, l3dstring, & + efield, efield_cart, efield_cry, transform_el, mapg_owner, phase_control PUBLIC :: allocate_bp_efield, deallocate_bp_efield, bp_global_map PUBLIC :: pdl_tot ! - LOGICAL :: & - lberry =.false., & ! if .TRUE. calculate polarization using Berry phase - lelfield=.false., & ! if .TRUE. finite electric field using Berry phase - lorbm=.false. ! if .TRUE. calculate orbital magnetization (Kubo terms) - INTEGER :: & - gdir, &! G-vector for polarization calculation - nppstr, &! number of k-points (parallel vector) - nberrycyc ! number of cycles for convergence in electric field - ! without changing the selfconsistent charge - REAL(DP) :: efield ! electric field intensity in a.u. + ! + LOGICAL :: lberry = .FALSE. + !! if .TRUE. calculate polarization using Berry phase + LOGICAL :: lelfield = .FALSE. + !! if .TRUE. finite electric field using Berry phase + LOGICAL :: lorbm = .FALSE. + !! if .TRUE. calculate orbital magnetization (Kubo terms) + INTEGER :: gdir + !! G-vector for polarization calculation + INTEGER :: nppstr + !! number of k-points (parallel vector) + INTEGER :: nberrycyc + !! number of cycles for convergence in electric field + !! without changing the selfconsistent charge + REAL(DP) :: efield + !! electric field intensity in a.u. COMPLEX(DP), ALLOCATABLE , TARGET :: evcel(:,:) - ! wavefunctions for calculating the electric field operator + !! wavefunctions for calculating the electric field operator COMPLEX(DP), ALLOCATABLE , TARGET :: evcelm(:,:,:) - ! wavefunctions for storing projectors for electric field operator + !! wavefunctions for storing projectors for electric field operator COMPLEX(DP), ALLOCATABLE , TARGET :: evcelp(:,:,:) - ! wavefunctions for storing projectors for electric field operator + !! wavefunctions for storing projectors for electric field operator COMPLEX(DP), ALLOCATABLE, TARGET :: fact_hepsi(:,:) - ! factors for hermitean electric field operators + !! factors for hermitean electric field operators !COMPLEX(DP), ALLOCATABLE, TARGET :: bec_evcel(:,:) - ! !for storing bec's factors with evcel + !! for storing bec's factors with evcel TYPE(bec_type) :: bec_evcel INTEGER, ALLOCATABLE, TARGET :: mapgp_global(:,:) - ! map for G'= G+1 correspondence + !! map for G'= G+1 correspondence INTEGER, ALLOCATABLE, TARGET :: mapgm_global(:,:) - ! map for G'= G-1 correspondence - REAL(DP) :: ion_pol(3) ! the ionic polarization - REAL(DP) :: el_pol(3) ! the electronic polarization - REAL(DP) :: fc_pol(3) ! the prefactor for the electronic polarization - LOGICAL :: l_el_pol_old! if true there is already stored a n older value for the polarization - ! neeeded for having correct polarization during MD - REAL(DP) :: el_pol_old(3)! the old electronic polarization - REAL(DP) :: el_pol_acc(3)! accumulator for the electronic polarization - - INTEGER :: nppstr_3d(3) ! number of element of strings along the reciprocal directions - INTEGER, ALLOCATABLE :: nx_el(:,:) ! index for string to k-point map, (nks*nspin,dir=3) - LOGICAL :: l3dstring ! if true strings are on the 3 three directions - REAL(DP) :: efield_cart(3) ! electric field vector in cartesian units - REAL(DP) :: efield_cry(3) ! electric field vector in crystal units - REAL(DP) :: transform_el(3,3)! transformation matrix from cartesian coordinates to normed reciprocal space + !! map for G'= G-1 correspondence + REAL(DP) :: ion_pol(3) + !! the ionic polarization + REAL(DP) :: el_pol(3) + !! the electronic polarization + REAL(DP) :: fc_pol(3) + !! the prefactor for the electronic polarization + LOGICAL :: l_el_pol_old + !! if true there is already stored a n older value for the polarization + !! neeeded for having correct polarization during MD + REAL(DP) :: el_pol_old(3) + !! the old electronic polarization + REAL(DP) :: el_pol_acc(3) + !! accumulator for the electronic polarization + ! + INTEGER :: nppstr_3d(3) + !! number of element of strings along the reciprocal directions + INTEGER, ALLOCATABLE :: nx_el(:,:) + !! index for string to k-point map, (nks*nspin,dir=3) + LOGICAL :: l3dstring + !! if true strings are on the 3 three directions + REAL(DP) :: efield_cart(3) + !! electric field vector in cartesian units + REAL(DP) :: efield_cry(3) + !! electric field vector in crystal units + REAL(DP) :: transform_el(3,3) + !! transformation matrix from cartesian coordinates to normed reciprocal + !! space INTEGER, ALLOCATABLE :: mapg_owner(:,:) - REAL(DP) :: pdl_tot ! the total phase calculated from bp_c_phase - INTEGER :: phase_control! 0 no control, 1 write, 2 read -! -CONTAINS - - SUBROUTINE allocate_bp_efield ( ) - + REAL(DP) :: pdl_tot + !! the total phase calculated from bp_c_phase + INTEGER :: phase_control + !! 0 no control, 1 write, 2 read + ! + CONTAINS + ! + !------------------------------------------------------------------------- + SUBROUTINE allocate_bp_efield() + !----------------------------------------------------------------------- + !! Allocate memory for the Berry's phase electric field. + ! NOTICE: should be allocated ONLY in parallel case, for gdir=1 or 2 + ! USE gvect, ONLY : ngm_g - ! allocate memory for the Berry's phase electric field - ! NOTICE: should be allocated ONLY in parallel case, for gdir=1 or 2 - - IMPLICIT NONE - - IF ( lberry .OR. lelfield .OR. lorbm ) THEN - ALLOCATE(mapgp_global(ngm_g,3)) - ALLOCATE(mapgm_global(ngm_g,3)) - ALLOCATE(mapg_owner(2,ngm_g)) - ENDIF - - l_el_pol_old=.false. - el_pol_acc=0.d0 - - RETURN + ! + IMPLICIT NONE + ! + IF ( lberry .OR. lelfield .OR. lorbm ) THEN + ALLOCATE(mapgp_global(ngm_g,3)) + ALLOCATE(mapgm_global(ngm_g,3)) + ALLOCATE(mapg_owner(2,ngm_g)) + ENDIF + ! + l_el_pol_old = .FALSE. + el_pol_acc = 0.d0 + ! + ! + RETURN + ! END SUBROUTINE allocate_bp_efield - + ! + ! + !-------------------------------------------------------------------------- SUBROUTINE deallocate_bp_efield - - ! deallocate memory used in Berry's phase electric field calculation - + !------------------------------------------------------------------------ + !! Deallocate memory used in Berry's phase electric field calculation + ! IMPLICIT NONE - + ! IF ( lberry .OR. lelfield .OR. lorbm ) THEN - IF ( ALLOCATED(mapgp_global) ) DEALLOCATE(mapgp_global) - IF ( ALLOCATED(mapgm_global) ) DEALLOCATE(mapgm_global) - IF ( ALLOCATED(nx_el) ) DEALLOCATE(nx_el) - IF ( ALLOCATED(mapg_owner) ) DEALLOCATE (mapg_owner) + IF ( ALLOCATED(mapgp_global) ) DEALLOCATE( mapgp_global ) + IF ( ALLOCATED(mapgm_global) ) DEALLOCATE( mapgm_global ) + IF ( ALLOCATED(nx_el) ) DEALLOCATE( nx_el ) + IF ( ALLOCATED(mapg_owner) ) DEALLOCATE( mapg_owner ) ENDIF - + ! + ! RETURN + ! END SUBROUTINE deallocate_bp_efield - + ! + ! + !------------------------------------------------------------------------- SUBROUTINE bp_global_map - - !this subroutine sets up the global correspondence map G+1 and G-1 - - USE mp, ONLY : mp_sum - USE mp_images, ONLY : me_image, intra_image_comm - USE gvect, ONLY : ngm_g, g, ngm, ig_l2g - USE fft_base, ONLY : dfftp - USE cell_base, ONLY : at - - IMPLICIT NONE - - INTEGER :: ig, mk1,mk2,mk3, idir, imk(3) - INTEGER, ALLOCATABLE :: ln_g(:,:,:) - INTEGER, ALLOCATABLE :: g_ln(:,:) - - IF ( .NOT.lberry .AND. .NOT. lelfield .AND. .NOT. lorbm ) RETURN - ! set up correspondence ln_g ix,iy,iz ---> global g index in - ! (for now...) coarse grid - ! and inverse realtion global g (coarse) to ix,iy,iz - - ALLOCATE(ln_g(-dfftp%nr1:dfftp%nr1,-dfftp%nr2:dfftp%nr2,-dfftp%nr3:dfftp%nr3)) - ALLOCATE(g_ln(3,ngm_g)) - - ln_g(:,:,:)=0!it means also not found - DO ig=1,ngm - mk1=nint(g(1,ig)*at(1,1)+g(2,ig)*at(2,1)+g(3,ig)*at(3,1)) - mk2=nint(g(1,ig)*at(1,2)+g(2,ig)*at(2,2)+g(3,ig)*at(3,2)) - mk3=nint(g(1,ig)*at(1,3)+g(2,ig)*at(2,3)+g(3,ig)*at(3,3)) - ln_g(mk1,mk2,mk3)=ig_l2g(ig) - ENDDO - CALL mp_sum(ln_g(:,:,:),intra_image_comm) - - - g_ln(:,:)= 0!it means also not found - DO ig=1,ngm - mk1=nint(g(1,ig)*at(1,1)+g(2,ig)*at(2,1)+g(3,ig)*at(3,1)) - mk2=nint(g(1,ig)*at(1,2)+g(2,ig)*at(2,2)+g(3,ig)*at(3,2)) - mk3=nint(g(1,ig)*at(1,3)+g(2,ig)*at(2,3)+g(3,ig)*at(3,3)) - g_ln(1,ig_l2g(ig))=mk1 - g_ln(2,ig_l2g(ig))=mk2 - g_ln(3,ig_l2g(ig))=mk3 - ENDDO - CALL mp_sum(g_ln(:,:),intra_image_comm) - -!loop on direction - DO idir=1,3 -!for every g on global array find G+1 and G-1 and put on - DO ig=1,ngm_g - imk(:)=g_ln(:,ig) - imk(idir)=imk(idir)+1 -!table array - mapgp_global(ig,idir)=ln_g(imk(1),imk(2),imk(3)) - imk(idir)=imk(idir)-2 - mapgm_global(ig,idir)=ln_g(imk(1),imk(2),imk(3)) + !----------------------------------------------------------------------- + !! This subroutine sets up the global correspondence map G+1 and G-1. + ! + USE mp, ONLY : mp_sum + USE mp_images, ONLY : me_image, intra_image_comm + USE gvect, ONLY : ngm_g, g, ngm, ig_l2g + USE fft_base, ONLY : dfftp + USE cell_base, ONLY : at + ! + IMPLICIT NONE + ! + INTEGER :: ig, mk1,mk2,mk3, idir, imk(3) + INTEGER, ALLOCATABLE :: ln_g(:,:,:) + INTEGER, ALLOCATABLE :: g_ln(:,:) + ! + IF ( .NOT.lberry .AND. .NOT. lelfield .AND. .NOT. lorbm ) RETURN + ! set up correspondence ln_g ix,iy,iz ---> global g index in + ! (for now...) coarse grid + ! and inverse realtion global g (coarse) to ix,iy,iz + ! + ALLOCATE( ln_g(-dfftp%nr1:dfftp%nr1,-dfftp%nr2:dfftp%nr2,-dfftp%nr3:dfftp%nr3) ) + ALLOCATE( g_ln(3,ngm_g) ) + ! + ln_g(:,:,:)=0!it means also not found + DO ig=1,ngm + mk1 = NINT( g(1,ig)*at(1,1) + g(2,ig)*at(2,1) + g(3,ig)*at(3,1) ) + mk2 = NINT( g(1,ig)*at(1,2) + g(2,ig)*at(2,2) + g(3,ig)*at(3,2) ) + mk3 = NINT( g(1,ig)*at(1,3) + g(2,ig)*at(2,3) + g(3,ig)*at(3,3) ) + ln_g(mk1,mk2,mk3)=ig_l2g(ig) + ENDDO + ! + CALL mp_sum( ln_g(:,:,:), intra_image_comm ) + ! + g_ln(:,:) = 0 !it means also not found + ! + DO ig = 1, ngm + mk1 = NINT( g(1,ig)*at(1,1) + g(2,ig)*at(2,1) + g(3,ig)*at(3,1) ) + mk2 = NINT( g(1,ig)*at(1,2) + g(2,ig)*at(2,2) + g(3,ig)*at(3,2) ) + mk3 = NINT( g(1,ig)*at(1,3) + g(2,ig)*at(2,3) + g(3,ig)*at(3,3) ) + g_ln(1,ig_l2g(ig)) = mk1 + g_ln(2,ig_l2g(ig)) = mk2 + g_ln(3,ig_l2g(ig)) = mk3 + ENDDO + ! + CALL mp_sum( g_ln(:,:), intra_image_comm ) + ! + !loop on direction + DO idir = 1, 3 + ! for every g on global array find G+1 and G-1 and put on + DO ig = 1, ngm_g + imk(:) = g_ln(:,ig) + imk(idir) = imk(idir)+1 + ! table array + mapgp_global(ig,idir) = ln_g(imk(1),imk(2),imk(3)) + imk(idir) = imk(idir)-2 + mapgm_global(ig,idir) = ln_g(imk(1),imk(2),imk(3)) ENDDO + ! ENDDO - - mapg_owner=0 - DO ig=1,ngm - mapg_owner(1,ig_l2g(ig))=me_image+1 - mapg_owner(2,ig_l2g(ig))=ig - END DO - call mp_sum(mapg_owner, intra_image_comm) - - DEALLOCATE(ln_g,g_ln) - + ! + mapg_owner = 0 + DO ig = 1, ngm + mapg_owner(1,ig_l2g(ig)) = me_image + 1 + mapg_owner(2,ig_l2g(ig)) = ig + ENDDO + ! + CALL mp_sum( mapg_owner, intra_image_comm ) + ! + DEALLOCATE( ln_g, g_ln ) + ! + ! RETURN - + ! END SUBROUTINE bp_global_map - + ! END MODULE bp diff --git a/PW/src/bp_qvan3.f90 b/PW/src/bp_qvan3.f90 index 7cf62d8e35..6adfaba7f4 100644 --- a/PW/src/bp_qvan3.f90 +++ b/PW/src/bp_qvan3.f90 @@ -7,71 +7,93 @@ ! ! Modified by PG - Oct.2007: removed obsolete comments !-------------------------------------------------------------------------- - subroutine qvan3(iv,jv,is,qg,ylm_k,qr) -!-------------------------------------------------------------------------- -! -! calculate qg = SUM_LM (-I)^L AP(LM,iv,jv) YR_LM QRAD(iv,jv,L,is) - USE kinds, ONLY: DP - USE ions_base, ONLY : ntyp => nsp - USE us, ONLY: dq, qrad - USE uspp_param, ONLY: lmaxq, nbetam - USE uspp, ONLY: nlx, lpl, lpx, ap, indv, nhtol, nhtolm - - implicit none - integer :: iv,jv,is - complex(DP) :: qg,sig - real(DP) :: ylm_k(lmaxq*lmaxq) - real(DP) :: qr(nbetam,nbetam,lmaxq,ntyp) - - integer ivs,jvs,ivl,jvl,lp,l,i +SUBROUTINE qvan3( iv, jv, is, qg, ylm_k, qr ) + !--------------------------------------------------------------------- + !! It calculates: + !! \[ \text{qg} = \sum_{LM} (-I)^L \text{AP}(LM,\text{iv}, + !! \text{jv}) \text{YR}_{LM} \text{QRAD}(\text{iv}, + !! \text{jv},L,\text{is}) \] + ! + ! It calculates: qg = SUM_LM (-I)^L AP(LM,iv,jv) YR_LM QRAD(iv,jv,L,is) + ! + USE kinds, ONLY: DP + USE ions_base, ONLY: ntyp => nsp + USE us, ONLY: dq, qrad + USE uspp_param, ONLY: lmaxq, nbetam + USE uspp, ONLY: nlx, lpl, lpx, ap, indv, nhtol, nhtolm + ! + IMPLICIT NONE + ! + INTEGER :: iv + !! beta function index + INTEGER :: jv + !! beta function index + INTEGER :: is + !! atomic type + COMPLEX(DP) :: qg + !! output: see routine comments + REAL(DP) :: ylm_k(lmaxq*lmaxq) + !! q-space real spherical harmonics at dk [\(Y_{LM}\)] + REAL(DP) :: qr(nbetam,nbetam,lmaxq,ntyp) + !! Bessel transform of \(Q_{ij}(|r|)\) at dk [\(Q_{ij}^L(|r|)\)] + ! + ! ... local variables + ! + COMPLEX(DP) :: sig + INTEGER :: ivs, jvs, ivl, jvl, lp, l, i + ! + ! ivs = indv(iv,is) jvs = indv(jv,is) ivl = nhtolm(iv,is) jvl = nhtolm(jv,is) - - if (ivs > nbetam .OR. jvs > nbetam) & - call errore (' qvan3 ', ' wrong dimensions (1)', MAX(ivs,jvs)) - if (ivl > nlx .OR. jvl > nlx) & - call errore (' qvan3 ', ' wrong dimensions (2)', MAX(ivl,jvl)) - - qg = (0.0d0,0.0d0) - + ! + IF (ivs > nbetam .OR. jvs > nbetam) & + CALL errore( ' qvan3 ', ' wrong dimensions (1)', MAX(ivs,jvs) ) + IF (ivl > nlx .OR. jvl > nlx) & + CALL errore( ' qvan3 ', ' wrong dimensions (2)', MAX(ivl,jvl) ) + ! + qg = (0.0_DP,0.0_DP) + ! !odl Write(*,*) 'QVAN3 -- ivs jvs = ',ivs,jvs !odl Write(*,*) 'QVAN3 -- ivl jvl = ',ivl,jvl - do i=1,lpx(ivl,jvl) + DO i = 1, lpx(ivl,jvl) !odl Write(*,*) 'QVAN3 -- i = ',i lp = lpl(ivl,jvl,i) !odl Write(*,*) 'QVAN3 -- lp = ',lp - -! EXTRACTION OF ANGULAR MOMENT L FROM LP: - - if (lp.eq.1) then + ! + ! ... EXTRACTION OF ANGULAR MOMENT L FROM LP: + ! + IF (lp == 1) THEN l = 1 - else if ((lp.ge.2) .and. (lp.le.4)) then + ELSEIF ((lp >= 2).AND.(lp <= 4)) THEN l = 2 - else if ((lp.ge.5) .and. (lp.le.9)) then + ELSEIF ((lp >= 5).AND.(lp <= 9)) THEN l = 3 - else if ((lp.ge.10).and.(lp.le.16)) then + ELSEIF ((lp >= 10).AND.(lp <= 16)) THEN l = 4 - else if ((lp.ge.17).and.(lp.le.25)) then + ELSEIF ((lp >= 17).AND.(lp <= 25)) THEN l = 5 - else if ((lp.ge.26).and.(lp.le.36)) then + ELSEIF ((lp >= 26).AND.(lp <= 36)) THEN l = 6 - else if ((lp.ge.37).and.(lp.le.49)) then + ELSEIF ((lp >= 37).AND.(lp <= 49)) THEN l = 7 - else if (lp.gt.49) then - call errore(' qvan3 ',' l not programmed ',lp) - end if - - sig = (0.d0,-1.d0)**(l-1) + ELSEIF (lp > 49) THEN + CALL errore( ' qvan3 ',' l not programmed ', lp ) + ENDIF + ! + sig = (0.0_DP,-1.0_DP)**(l-1) sig = sig * ap(lp,ivl,jvl) - + ! !odl Write(*,*) 'QVAN3 -- sig = ',sig - -! WRITE( stdout,*) 'qvan3',ng1,LP,L,ivs,jvs - - qg = qg + sig * ylm_k(lp) * qr(ivs,jvs,l,is) - - end do - return - end subroutine qvan3 + ! + ! WRITE( stdout,*) 'qvan3',ng1,LP,L,ivs,jvs + ! + qg = qg + sig * ylm_k(lp) * qr(ivs,jvs,l,is) + ! + ENDDO + ! + ! + RETURN + ! +END SUBROUTINE qvan3 diff --git a/PW/src/bp_strings.f90 b/PW/src/bp_strings.f90 index 8ca75e5258..c737f25091 100644 --- a/PW/src/bp_strings.f90 +++ b/PW/src/bp_strings.f90 @@ -5,16 +5,15 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! -SUBROUTINE kp_strings ( nppstr, gdir, nrot, s, bg, npk, & +SUBROUTINE kp_strings( nppstr, gdir, nrot, s, bg, npk, & k1,k2,k3, nk1,nk2,nk3, nks, xk, wk ) - - -! --- Usage of modules --- - USE kinds, ONLY: dp - -! --- No implicit definitions --- + !! * Generate a k-point grid in the two dimensions other than gdir; + !! * generate a string of k-points for every k-point in the 2D grid. + ! + USE kinds, ONLY: DP + ! IMPLICIT NONE - + ! ! --- Input arguments --- INTEGER , INTENT(IN) :: k1 INTEGER , INTENT(IN) :: k2 @@ -27,12 +26,12 @@ SUBROUTINE kp_strings ( nppstr, gdir, nrot, s, bg, npk, & INTEGER , INTENT(IN) :: nrot INTEGER , INTENT(IN) :: gdir INTEGER , INTENT(IN) :: s(3,3,48) - REAL(dp) , INTENT(IN) :: bg(3,3) + REAL(DP) , INTENT(IN) :: bg(3,3) ! --- Output arguments --- INTEGER , INTENT(OUT) :: nks - REAL(dp), INTENT(OUT) :: xk(3,npk) - REAL(dp), INTENT(OUT) :: wk(npk) + REAL(DP), INTENT(OUT) :: xk(3,npk) + REAL(DP), INTENT(OUT) :: wk(npk) ! --- Internal definitions --- INTEGER :: ipar @@ -40,10 +39,10 @@ SUBROUTINE kp_strings ( nppstr, gdir, nrot, s, bg, npk, & INTEGER :: kindex ! time reversal and no magnetic symmetries assumed INTEGER :: t_rev(48) = 0 - LOGICAL :: time_reversal = .true., skip_equivalence=.FALSE. - REAL(dp) :: dk(3) - REAL(dp) :: xk0(3,npk) - REAL(dp) :: wk0(npk) + LOGICAL :: time_reversal = .TRUE., skip_equivalence=.FALSE. + REAL(DP) :: dk(3) + REAL(DP) :: xk0(3,npk) + REAL(DP) :: wk0(npk) ! --- Generate a k-point grid in the two dimensions other than gdir --- IF (gdir == 1) THEN @@ -61,17 +60,17 @@ SUBROUTINE kp_strings ( nppstr, gdir, nrot, s, bg, npk, & END IF ! --- Generate a string of k-points for every k-point in the 2D grid --- - kindex=0 - dk(1)=bg(1,gdir)/REAL(nppstr-1,dp) - dk(2)=bg(2,gdir)/REAL(nppstr-1,dp) - dk(3)=bg(3,gdir)/REAL(nppstr-1,dp) - DO iort=1,nks - DO ipar=1,nppstr - kindex=kindex+1 - xk(1,kindex)=xk0(1,iort)+REAL(ipar-1,dp)*dk(1) - xk(2,kindex)=xk0(2,iort)+REAL(ipar-1,dp)*dk(2) - xk(3,kindex)=xk0(3,iort)+REAL(ipar-1,dp)*dk(3) - wk(kindex)=wk0(iort)/REAL(nppstr,dp) + kindex = 0 + dk(1) = bg(1,gdir) / REAL(nppstr-1,DP) + dk(2) = bg(2,gdir) / REAL(nppstr-1,DP) + dk(3) = bg(3,gdir) / REAL(nppstr-1,DP) + DO iort = 1,nks + DO ipar = 1, nppstr + kindex = kindex+1 + xk(1,kindex) = xk0(1,iort) + REAL(ipar-1,DP)*dk(1) + xk(2,kindex) = xk0(2,iort) + REAL(ipar-1,DP)*dk(2) + xk(3,kindex) = xk0(3,iort) + REAL(ipar-1,DP)*dk(3) + wk(kindex) = wk0(iort) / REAL(nppstr,DP) END DO END DO nks=nks*nppstr diff --git a/PW/src/buffers.f90 b/PW/src/buffers.f90 index a584795185..2325da51fd 100644 --- a/PW/src/buffers.f90 +++ b/PW/src/buffers.f90 @@ -14,6 +14,7 @@ ! ! <<^V^\\=========================================//-//-//========//O\\// MODULE buiol + ! USE kinds, ONLY : DP ! PUBLIC :: init_buiol ! init the linked chain of i/o units @@ -30,35 +31,39 @@ MODULE buiol PUBLIC :: buiol_read_record ! (unit, recl, nrec, DATA) read DATA(recl) from record nrec of unit ! PRIVATE - ! initial number of records in the buffer (each record will only be allocated on write!) + ! INTEGER,PARAMETER :: nrec0 = 1024 - ! when writing beyond the last available record increase the index by AT LEAST this factor.. + !! initial number of records in the buffer (each record will only be allocated on write!) + REAL(DP),PARAMETER :: fact0 = 1.5_dp - ! .. furthermore, allocate up to AT LEAST this factor times the required overflowing nrec + !! when writing beyond the last available record increase the index by AT LEAST this factor.. + REAL(DP),PARAMETER :: fact1 = 1.2_dp + !! .. furthermore, allocate up to AT LEAST this factor times the required overflowing nrec + ! ! NOTE: the new buffer size will be determined with both methods, taking the MAX of the two ! - ! Size of the single item of the record (for memory usage report only) INTEGER,PARAMETER :: size0 = DP ! 8 bytes + !! Size of the single item of the record (for memory usage report only) ! - ! base element of the linked chain of buffers TYPE index_of_list + !! base element of the linked chain of buffers TYPE(data_in_the_list),POINTER :: index(:) INTEGER :: nrec, unit, recl CHARACTER(LEN=256) :: extension, save_dir TYPE(index_of_list),POINTER :: next => null() END TYPE ! - ! sub-structure containing the data buffer TYPE data_in_the_list + !! sub-structure containing the data buffer COMPLEX(DP), POINTER :: data(:) => null() END TYPE ! - ! beginning of the linked chain, statically allocated (for implementation simplicity) TYPE(index_of_list),SAVE,POINTER :: ENTRY => null() + !! beginning of the linked chain, statically allocated (for implementation simplicity) ! - ! set to true when the library has been initialized LOGICAL,SAVE :: is_init_buiol = .false. + !! set to true when the library has been initialized ! CONTAINS ! <<^V^\\=========================================//-//-//========//O\\// @@ -481,14 +486,15 @@ END SUBROUTINE dealloc_buffer ! \/o\________\\\_________________________________________/^> END MODULE buiol ! <<^V^\\=========================================//-//-//========//O\\// - -Module buffers - - use kinds, only: dp - use buiol, only: init_buiol, buiol_open_unit, buiol_close_unit, & +! +MODULE buffers + ! + USE kinds, ONLY: DP + USE buiol, ONLY: init_buiol, buiol_open_unit, buiol_close_unit, & buiol_check_unit, buiol_get_ext, buiol_get_dir, & buiol_read_record, buiol_write_record, is_init_buiol - implicit none + ! + IMPLICIT NONE ! ! QE interfaces to BUIOL module ! @@ -497,22 +503,21 @@ Module buffers PRIVATE INTEGER:: nunits = 0 ! -contains - - !---------------------------------------------------------------------------- - SUBROUTINE open_buffer (unit, extension, nword, io_level, exst, exst_file, direc) - !--------------------------------------------------------------------------- - ! - ! io_level>0: connect unit "unit" to file "wfc_dir"/"prefix"."extension" - ! (or "direc"/"prefix"."extension" if optional variable direc specified) - ! for direct I/O access, with record length = nword complex numbers; - ! on output, exst=T(F) if the file (does not) exists +CONTAINS + ! + !--------------------------------------------------------------------------------- + SUBROUTINE open_buffer( unit, extension, nword, io_level, exst, exst_file, direc ) + !------------------------------------------------------------------------------- + !! io_level>0: connect unit "unit" to file "wfc_dir"/"prefix"."extension" + !! (or "direc"/"prefix"."extension" if optional variable direc specified) + !! for direct I/O access, with record length = nword complex numbers; + !! on output, exst=T(F) if the file (does not) exists. ! - ! io_level=0: open a buffer for storing records of length nword complex - ! numbers; store in memory file-related variables for later usage. - ! on output, exst=T(F) if the buffer is already allocated + !! io_level=0: open a buffer for storing records of length nword complex + !! numbers; store in memory file-related variables for later usage. + !! on output, exst=T(F) if the buffer is already allocated. ! - ! on output, optional variable exst_file=T(F) if file is present (absent) + !! On output, optional variable exst_file=T(F) if file is present (absent). ! USE io_files, ONLY : diropn, wfc_dir ! @@ -529,43 +534,44 @@ SUBROUTINE open_buffer (unit, extension, nword, io_level, exst, exst_file, direc ! ! not-so-elegant way to initialize the linked chain with units ! - IF ( nunits == 0 ) CALL init_buiol( ) + IF ( nunits == 0 ) CALL init_buiol() ! IF (extension == ' ') & - CALL errore ('open_buffer','filename extension not given',1) + CALL errore( 'open_buffer', 'filename extension not given', 1 ) ! - IF (present(direc)) THEN - save_dir=TRIM(direc) + IF (PRESENT(direc)) THEN + save_dir = TRIM(direc) ELSE - save_dir=TRIM(wfc_dir) + save_dir = TRIM(wfc_dir) ENDIF ! IF ( io_level <= 0 ) THEN - CALL diropn ( unit, extension, -1, exst, save_dir ) - IF (present(exst_file)) exst_file=exst - ierr = buiol_open_unit ( unit, nword, extension, save_dir ) - IF ( ierr > 0 ) CALL errore ('open_buffer', ' cannot open unit', 2) + CALL diropn( unit, extension, -1, exst, save_dir ) + IF (PRESENT(exst_file)) exst_file=exst + ierr = buiol_open_unit( unit, nword, extension, save_dir ) + IF ( ierr > 0 ) CALL errore( 'open_buffer', ' cannot open unit', 2 ) exst = ( ierr == -1 ) IF (exst) THEN - CALL infomsg ('open_buffer', 'unit already opened') + CALL infomsg( 'open_buffer', 'unit already opened' ) nunits = nunits - 1 END IF ELSE - CALL diropn ( unit, extension, 2*nword, exst, save_dir ) - IF (present(exst_file)) exst_file=exst + CALL diropn( unit, extension, 2*nword, exst, save_dir ) + IF (PRESENT(exst_file)) exst_file=exst ENDIF nunits = nunits + 1 ! RETURN ! END SUBROUTINE open_buffer + ! + ! !---------------------------------------------------------------------------- SUBROUTINE save_buffer( vect, nword, unit, nrec ) - !--------------------------------------------------------------------------- - ! - ! ... copy vect(1:nword) into the "nrec"-th record of a previously - ! ... allocated buffer / opened direct-access file, depending upon - ! ... how "open_buffer" was called + !-------------------------------------------------------------------------- + !! Copy vect(1:nword) into the "nrec"-th record of a previously + !! allocated buffer / opened direct-access file, depending upon + !! how "open_buffer" was called. ! IMPLICIT NONE ! @@ -573,28 +579,27 @@ SUBROUTINE save_buffer( vect, nword, unit, nrec ) COMPLEX(DP), INTENT(INOUT) :: vect(nword) INTEGER :: ierr ! - ierr = buiol_check_unit (unit) + ierr = buiol_check_unit( unit ) IF( ierr > 0 ) THEN - ierr = buiol_write_record ( unit, nword, nrec, vect ) - if ( ierr > 0 ) & - CALL errore ('save_buffer', 'cannot write record', unit) + ierr = buiol_write_record( unit, nword, nrec, vect ) + IF ( ierr > 0 ) & + CALL errore( 'save_buffer', 'cannot write record', unit ) #if defined(__DEBUG) print *, 'save_buffer: record', nrec, ' written to unit', unit #endif ELSE - CALL davcio ( vect, 2*nword, unit, nrec, +1 ) - END IF + CALL davcio( vect, 2*nword, unit, nrec, +1 ) + ENDIF ! END SUBROUTINE save_buffer ! !---------------------------------------------------------------------------- SUBROUTINE get_buffer( vect, nword, unit, nrec ) - !--------------------------------------------------------------------------- - ! - ! ... copy vect(1:nword) from the "nrec"-th record of a previously - ! ... allocated buffer / opened direct-access file, depending upon - ! ... how "open_buffer" was called. If buffer access was chosen - ! ... but buffer is not allocated, open the file, read from file + !!--------------------------------------------------------------------------- + !! Copy vect(1:nword) from the "nrec"-th record of a previously + !! allocated buffer / opened direct-access file, depending upon + !! how "open_buffer" was called. If buffer access was chosen + !! but buffer is not allocated, open the file, read from file. ! USE io_files, ONLY : diropn ! @@ -606,44 +611,45 @@ SUBROUTINE get_buffer( vect, nword, unit, nrec ) INTEGER :: ierr LOGICAL :: opnd ! - ierr = buiol_check_unit (unit) + ierr = buiol_check_unit( unit ) IF( ierr > 0 ) THEN - ierr = buiol_read_record ( unit, nword, nrec, vect ) + ierr = buiol_read_record( unit, nword, nrec, vect ) #if defined(__DEBUG) - print *, 'get_buffer: record', nrec, ' read from unit', unit + PRINT *, 'get_buffer: record', nrec, ' read from unit', unit #endif - if ( ierr < 0 ) then + IF ( ierr < 0 ) THEN ! record not found: open file if not opened, read from it... INQUIRE( UNIT = unit, OPENED = opnd ) IF ( .NOT. opnd ) THEN - extension = buiol_get_ext (unit) - save_dir = buiol_get_dir (unit) - CALL diropn ( unit, extension, 2*nword, opnd, save_dir ) + extension = buiol_get_ext(unit) + save_dir = buiol_get_dir(unit) + CALL diropn( unit, extension, 2*nword, opnd, save_dir ) END IF - CALL davcio ( vect, 2*nword, unit, nrec, -1 ) + CALL davcio( vect, 2*nword, unit, nrec, -1 ) ! ... and save to memory - ierr = buiol_write_record ( unit, nword, nrec, vect ) - if ( ierr /= 0 ) CALL errore ('get_buffer', & - 'cannot store record in memory', unit) + ierr = buiol_write_record( unit, nword, nrec, vect ) + IF ( ierr /= 0 ) CALL errore( 'get_buffer', & + 'cannot store record in memory', unit ) #if defined(__DEBUG) - print *, 'get_buffer: record', nrec, ' read from file', unit + PRINT *, 'get_buffer: record', nrec, ' read from file', unit #endif - end if + ENDIF #if defined(__DEBUG) - print *, 'get_buffer: record', nrec, ' read from unit', unit + PRINT *, 'get_buffer: record', nrec, ' read from unit', unit #endif ELSE - CALL davcio ( vect, 2*nword, unit, nrec, -1 ) - END IF + CALL davcio( vect, 2*nword, unit, nrec, -1 ) + ENDIF ! END SUBROUTINE get_buffer - - SUBROUTINE close_buffer ( unit, status ) - ! - ! close unit with status "status" ('keep' or 'delete') - ! deallocate related buffer if any; if "status='keep'" - ! save it to file (opening it if not already opened). - ! Does not complain if closing an already closed unit + ! + !------------------------------------------------------------ + SUBROUTINE close_buffer( unit, status ) + !---------------------------------------------------------- + !! Close unit with status "status" ('keep' or 'delete') + !! deallocate related buffer if any; if "status='keep'" + !! save it to file (opening it if not already opened). + !! Does not complain if closing an already closed unit. ! USE io_files, ONLY : diropn ! @@ -658,41 +664,41 @@ SUBROUTINE close_buffer ( unit, status ) LOGICAL :: opnd ! IF ( .NOT. is_init_buiol ) RETURN - nword = buiol_check_unit (unit) + nword = buiol_check_unit( unit ) ! IF( nword > 0 ) THEN ! data is in memory buffer - IF ( status == 'keep' .or. status == 'KEEP' ) then + IF ( status == 'keep' .OR. status == 'KEEP' ) THEN ! open file if not previously opened INQUIRE( UNIT = unit, OPENED = opnd ) IF ( .NOT. opnd ) THEN extension = buiol_get_ext (unit) save_dir = buiol_get_dir (unit) - CALL diropn ( unit, extension, 2*nword, opnd, save_dir ) - END IF - allocate (vect(nword)) + CALL diropn( unit, extension, 2*nword, opnd, save_dir ) + ENDIF + ALLOCATE( vect(nword) ) n = 1 - 10 continue - ierr = buiol_read_record ( unit, nword, n, vect ) - IF ( ierr /= 0 ) go to 20 - CALL davcio ( vect, 2*nword, unit, n, +1 ) + 10 CONTINUE + ierr = buiol_read_record( unit, nword, n, vect ) + IF ( ierr /= 0 ) GO TO 20 + CALL davcio( vect, 2*nword, unit, n, +1 ) n = n+1 - go to 10 - 20 deallocate (vect) - end if - ierr = buiol_close_unit ( unit ) + GO TO 10 + 20 DEALLOCATE( vect ) + ENDIF + ierr = buiol_close_unit( unit ) if ( ierr < 0 ) & - CALL errore ('close_buffer', 'error closing', ABS(unit)) + CALL errore( 'close_buffer', 'error closing', ABS(unit) ) #if defined(__DEBUG) - print *, 'close_buffer: unit ',unit, 'closed' + PRINT *, 'close_buffer: unit ',unit, 'closed' #endif - END IF + ENDIF INQUIRE( UNIT = unit, OPENED = opnd ) IF ( opnd ) CLOSE( UNIT = unit, STATUS = status ) nunits = nunits - 1 ! END SUBROUTINE close_buffer - + ! ! end interface for old "buffers" module - -end module buffers + ! +END MODULE buffers diff --git a/PW/src/c_bands.f90 b/PW/src/c_bands.f90 index bb2829afa3..6577118525 100644 --- a/PW/src/c_bands.f90 +++ b/PW/src/c_bands.f90 @@ -9,11 +9,10 @@ !---------------------------------------------------------------------------- SUBROUTINE c_bands( iter ) !---------------------------------------------------------------------------- - ! - ! ... Driver routine for Hamiltonian diagonalization routines - ! ... It reads the Hamiltonian and an initial guess of the wavefunctions - ! ... from a file and computes initialization quantities for the - ! ... diagonalization routines. + !! Driver routine for the Hamiltonian diagonalization ones. + !! It reads the Hamiltonian and an initial guess of the wavefunctions + !! from a file and computes initialization quantities for the + !! diagonalization routines. ! USE kinds, ONLY : DP USE io_global, ONLY : stdout @@ -26,7 +25,7 @@ SUBROUTINE c_bands( iter ) USE control_flags, ONLY : ethr, isolve, restart USE ldaU, ONLY : lda_plus_u, U_projection, wfcU USE lsda_mod, ONLY : current_spin, lsda, isk - USE wavefunctions, ONLY : evc + USE wavefunctions, ONLY : evc USE bp, ONLY : lelfield USE mp_pools, ONLY : npool, kunit, inter_pool_comm USE mp, ONLY : mp_sum @@ -34,7 +33,8 @@ SUBROUTINE c_bands( iter ) ! IMPLICIT NONE ! - INTEGER, INTENT (in) :: iter + INTEGER, INTENT(IN) :: iter + !! iteration index ! ! ... local variables ! @@ -44,14 +44,13 @@ SUBROUTINE c_bands( iter ) ! ik : counter on k points ! ik_: k-point already done in a previous run LOGICAL :: exst -!------------------------------------------------------------------------ - + ! ! CALL start_clock( 'c_bands' ); !write (*,*) 'start c_bands' ; FLUSH(6) ! ik_ = 0 avg_iter = 0.D0 - IF ( restart ) CALL restart_in_cbands(ik_, ethr, avg_iter, et ) + IF ( restart ) CALL restart_in_cbands( ik_, ethr, avg_iter, et ) ! ! ... If restarting, calculated wavefunctions have to be read from file ! ... (not needed for a single k-point: this is done in wfcinit, @@ -60,17 +59,17 @@ SUBROUTINE c_bands( iter ) DO ik = 1, ik_ IF ( nks > 1 .OR. lelfield ) & CALL get_buffer ( evc, nwordwfc, iunwfc, ik ) - END DO + ENDDO ! IF ( isolve == 0 ) THEN WRITE( stdout, '(5X,"Davidson diagonalization with overlap")' ) - ELSE IF ( isolve == 1 ) THEN + ELSEIF ( isolve == 1 ) THEN WRITE( stdout, '(5X,"CG style diagonalization")') - ELSE IF ( isolve == 2 ) THEN + ELSEIF ( isolve == 2 ) THEN WRITE( stdout, '(5X,"PPCG style diagonalization")') ELSE CALL errore ( 'c_bands', 'invalid type of diagonalization', isolve) - END IF + ENDIF ! ! ... For each k point diagonalizes the hamiltonian ! @@ -80,7 +79,7 @@ SUBROUTINE c_bands( iter ) ! current_k = ik IF ( lsda ) current_spin = isk(ik) - call g2_kin( ik ) + CALL g2_kin( ik ) ! ! ... More stuff needed by the hamiltonian: nonlocal projectors ! @@ -113,14 +112,14 @@ SUBROUTINE c_bands( iter ) ! nkdum = kunit * ( nkstot / kunit / npool ) ! - IF (ik .le. nkdum) THEN + IF (ik <= nkdum) THEN IF (check_stop_now()) THEN - CALL save_in_cbands(ik, ethr, avg_iter, et ) + CALL save_in_cbands( ik, ethr, avg_iter, et ) RETURN - END IF + ENDIF ENDIF ! - END DO k_loop + ENDDO k_loop ! CALL mp_sum( avg_iter, inter_pool_comm ) avg_iter = avg_iter / nkstot @@ -138,21 +137,20 @@ END SUBROUTINE c_bands !---------------------------------------------------------------------------- SUBROUTINE diag_bands( iter, ik, avg_iter ) !---------------------------------------------------------------------------- + !! Driver routine for diagonalization at each k-point. Types of iterative + !! diagonalizations currently in use: ! - ! ... Driver routine for diagonalization at each k-point - ! ... Two types of iterative diagonalizations are currently used: - ! ... a) Davidson algorithm (all-band) - ! ... b) Conjugate Gradient (band-by-band) - ! ... b) Projected Preconditioned Conjugate Gradient (block) - ! ... - ! ... internal procedures : + !! * Davidson algorithm (all-band); + !! * Conjugate Gradient (band-by-band); + !! * Projected Preconditioned Conjugate Gradient (block). ! - ! ... diag_bands_gamma(): optimized algorithms for gamma sampling of the BZ - ! ... (real Hamiltonian) - ! ... diag_bands_k() : general algorithm for arbitrary BZ sampling - ! ... (complex Hamiltonian) - ! ... test_exit_cond() : the test on the iterative diagonalization + !! Internal procedures: ! + !! * \(\textrm{diag_bands_gamma}\)(): optimized algorithms for gamma sampling + !! of the BZ (real Hamiltonian); + !! * \(\textrm{diag_bands_k}\)(): general algorithm for arbitrary BZ sampling + !! (complex Hamiltonian); + !! * \(\textrm{test_exit_cond}\)(): the test on the iterative diagonalization. ! USE kinds, ONLY : DP USE buffers, ONLY : get_buffer @@ -164,10 +162,10 @@ SUBROUTINE diag_bands( iter, ik, avg_iter ) USE control_flags, ONLY : ethr, lscf, max_cg_iter, max_ppcg_iter, isolve, & gamma_only, use_para_diag USE noncollin_module, ONLY : noncolin, npol - USE wavefunctions, ONLY : evc + USE wavefunctions, ONLY : evc USE g_psi_mod, ONLY : h_diag, s_diag USE scf, ONLY : v_of_0 - USE bp, ONLY : lelfield, evcel, evcelp, evcelm, bec_evcel,& + USE bp, ONLY : lelfield, evcel, evcelp, evcelm, bec_evcel, & gdir, l3dstring, efield, efield_cry USE becmod, ONLY : bec_type, becp, calbec, & allocate_bec_type, deallocate_bec_type @@ -178,11 +176,16 @@ SUBROUTINE diag_bands( iter, ik, avg_iter ) ! IMPLICIT NONE ! - INTEGER, INTENT(IN) :: iter, ik + INTEGER, INTENT(IN) :: iter + !! iteration index + INTEGER, INTENT(IN) :: ik + !! k-point index + REAL(KIND=DP), INTENT(INOUT) :: avg_iter + !! average number of H*psi products ! - REAL (KIND=DP), INTENT(INOUT) :: avg_iter + ! ... local variables ! - REAL (KIND=DP) :: cg_iter, ppcg_iter + REAL(KIND=DP) :: cg_iter, ppcg_iter ! (weighted) number of iterations in Conjugate-Gradient INTEGER :: npw, ig, dav_iter, ntry, notconv ! number of iterations in Davidson @@ -193,24 +196,25 @@ SUBROUTINE diag_bands( iter, ik, avg_iter ) LOGICAL :: lrot ! .TRUE. if the wfc have already be rotated ! - integer, parameter :: sbsize = 5, rrstep = 7 ! block dimensions used in PPCG - ! -! Davidson diagonalization uses these external routines on groups of nvec bands - external h_psi, s_psi, g_psi -! subroutine h_psi(npwx,npw,nvec,psi,hpsi) computes H*psi -! subroutine s_psi(npwx,npw,nvec,psi,spsi) computes S*psi (if needed) -! subroutine g_psi(npwx,npw,nvec,psi,eig) computes G*psi -> psi -!------------------------------------------------------------------------ -! CG diagonalization uses these external routines on a single band - external hs_1psi, s_1psi -! subroutine hs_1psi(npwx,npw,psi,hpsi,spsi) computes H*psi and S*psi -! subroutine s_1psi(npwx,npw,psi,spsi) computes S*psi (if needed) -! In addition to the above ithe initial wfc rotation uses h_psi, and s_psi -!------------------------------------------------------------------------ -! PPCG diagonalization uses these external routines on groups of bands -! subroutine h_psi(npwx,npw,nvec,psi,hpsi) computes H*psi -! subroutine s_psi(npwx,npw,nvec,psi,spsi) computes S*psi (if needed) - + INTEGER, PARAMETER :: sbsize = 5, rrstep = 7 + ! block dimensions used in PPCG + ! + ! Davidson diagonalization uses these external routines on groups of nvec bands + EXTERNAL h_psi, s_psi, g_psi + ! subroutine h_psi(npwx,npw,nvec,psi,hpsi) computes H*psi + ! subroutine s_psi(npwx,npw,nvec,psi,spsi) computes S*psi (if needed) + ! subroutine g_psi(npwx,npw,nvec,psi,eig) computes G*psi -> psi + !------------------------------------------------------------------------ + ! CG diagonalization uses these external routines on a single band + EXTERNAL hs_1psi, s_1psi + ! subroutine hs_1psi(npwx,npw,psi,hpsi,spsi) computes H*psi and S*psi + ! subroutine s_1psi(npwx,npw,psi,spsi) computes S*psi (if needed) + ! In addition to the above ithe initial wfc rotation uses h_psi, and s_psi + !------------------------------------------------------------------------ + ! PPCG diagonalization uses these external routines on groups of bands + ! subroutine h_psi(npwx,npw,nvec,psi,hpsi) computes H*psi + ! subroutine s_psi(npwx,npw,nvec,psi,spsi) computes S*psi (if needed) + ! ALLOCATE( h_diag( npwx, npol ), STAT=ierr ) IF( ierr /= 0 ) & CALL errore( ' diag_bands ', ' cannot allocate h_diag ', ABS(ierr) ) @@ -226,7 +230,7 @@ SUBROUTINE diag_bands( iter, ik, avg_iter ) ! ! ... allocate space for - used in h_psi and s_psi ! - CALL allocate_bec_type ( nkb, nbnd, becp, intra_bgrp_comm ) + CALL allocate_bec_type( nkb, nbnd, becp, intra_bgrp_comm ) ! npw = ngk(ik) IF ( gamma_only ) THEN @@ -237,11 +241,11 @@ SUBROUTINE diag_bands( iter, ik, avg_iter ) ! CALL diag_bands_k() ! - END IF + ENDIF ! ! ... deallocate work space ! - CALL deallocate_bec_type ( becp ) + CALL deallocate_bec_type( becp ) DEALLOCATE( s_diag ) DEALLOCATE( h_diag ) ! @@ -250,16 +254,16 @@ SUBROUTINE diag_bands( iter, ik, avg_iter ) CALL errore( 'c_bands', & & 'too many bands are not converged', 1 ) ! - ELSE IF ( notconv > 0 ) THEN + ELSEIF ( notconv > 0 ) THEN ! WRITE( stdout, '(5X,"c_bands: ",I2, & & " eigenvalues not converged")' ) notconv ! - END IF + ENDIF ! RETURN ! -CONTAINS + CONTAINS ! ! ... internal procedures ! @@ -291,11 +295,11 @@ SUBROUTINE diag_bands_gamma() ! IF ( .NOT. lrot ) THEN ! - CALL rotate_wfc ( npwx, npw, nbnd, gstart, nbnd, evc, npol, okvan, evc, et(1,ik) ) + CALL rotate_wfc( npwx, npw, nbnd, gstart, nbnd, evc, npol, okvan, evc, et(1,ik) ) ! avg_iter = avg_iter + 1.D0 ! - END IF + ENDIF ! IF ( isolve == 1 ) THEN CALL rcgdiagg( hs_1psi, s_1psi, h_diag, & @@ -307,11 +311,11 @@ SUBROUTINE diag_bands_gamma() ELSE CALL ppcg_gamma( h_psi, s_psi, okvan, h_diag, & npwx, npw, nbnd, evc, et(1,ik), btype(1,ik), & - 0.1d0*ethr, max_ppcg_iter, notconv, ppcg_iter, sbsize , rrstep, iter ) + 0.1d0*ethr, max_ppcg_iter, notconv, ppcg_iter, sbsize , rrstep, iter ) ! avg_iter = avg_iter + ppcg_iter ! - END IF + ENDIF ! ! ntry = ntry + 1 @@ -320,7 +324,7 @@ SUBROUTINE diag_bands_gamma() ! IF ( test_exit_cond() ) EXIT CG_loop ! - END DO CG_loop + ENDDO CG_loop ! ELSE ! @@ -345,13 +349,15 @@ SUBROUTINE diag_bands_gamma() ! ! make sure that all processors have the same wfc CALL pregterg( h_psi, s_psi, okvan, g_psi, & npw, npwx, nbnd, nbndx, evc, ethr, & - et(1,ik), btype(1,ik), notconv, lrot, dav_iter ) ! BEWARE gstart has been removed from call + et(1,ik), btype(1,ik), notconv, lrot, dav_iter ) + ! BEWARE gstart has been removed from call ! ELSE ! CALL regterg ( h_psi, s_psi, okvan, g_psi, & npw, npwx, nbnd, nbndx, evc, ethr, & - et(1,ik), btype(1,ik), notconv, lrot, dav_iter ) ! BEWARE gstart has been removed from call + et(1,ik), btype(1,ik), notconv, lrot, dav_iter ) + ! BEWARE gstart has been removed from call ENDIF ! avg_iter = avg_iter + dav_iter @@ -362,9 +368,10 @@ SUBROUTINE diag_bands_gamma() ! IF ( test_exit_cond() ) EXIT david_loop ! - END DO david_loop + ENDDO david_loop ! - END IF + ENDIF + ! ! RETURN ! @@ -373,16 +380,15 @@ END SUBROUTINE diag_bands_gamma !----------------------------------------------------------------------- SUBROUTINE diag_bands_k() !----------------------------------------------------------------------- - ! - ! ... Complex Hamiltonian diagonalization + !! Complex Hamiltonian diagonalization. ! IMPLICIT NONE ! - ! ... here the local variables + ! ... local variables ! INTEGER :: ipol - REAL(dp) :: eps=0.000001d0 - ! --- Define a small number --- + REAL(DP) :: eps=0.000001d0 + ! --- Define a small number --- ! !write (*,*) ' enter diag_bands_k'; FLUSH(6) IF ( lelfield ) THEN @@ -393,28 +399,27 @@ SUBROUTINE diag_bands_k() ! !... read projectors from disk ! - if(.not.l3dstring .and. ABS(efield)>eps ) then + IF (.NOT.l3dstring .AND. ABS(efield)>eps ) THEN CALL get_buffer (evcelm(:,:,gdir), nwordwfc, iunefieldm, ik+(gdir-1)*nks) CALL get_buffer (evcelp(:,:,gdir), nwordwfc, iunefieldp, ik+(gdir-1)*nks) - else - do ipol=1,3 - if(ABS(efield_cry(ipol))>eps) then - CALL get_buffer (evcelm(:,:,ipol), nwordwfc, iunefieldm, ik+(ipol-1)*nks) - CALL get_buffer (evcelp(:,:,ipol), nwordwfc, iunefieldp, ik+(ipol-1)*nks) - endif - enddo - endif + ELSE + DO ipol = 1, 3 + IF ( ABS(efield_cry(ipol))>eps ) THEN + CALL get_buffer( evcelm(:,:,ipol), nwordwfc, iunefieldm, ik+(ipol-1)*nks ) + CALL get_buffer( evcelp(:,:,ipol), nwordwfc, iunefieldp, ik+(ipol-1)*nks ) + ENDIF + ENDDO + ENDIF ! IF ( okvan ) THEN ! - call allocate_bec_type(nkb,nbnd,bec_evcel) - + CALL allocate_bec_type( nkb, nbnd, bec_evcel ) ! - CALL calbec(npw, vkb, evcel, bec_evcel) + CALL calbec( npw, vkb, evcel, bec_evcel ) ! ENDIF ! - END IF + ENDIF ! !write (*,*) ' current isolve value ( 0 Davidson, 1 CG, 2 PPCG)', isolve; FLUSH(6) IF ( isolve == 1 .OR. isolve == 2) THEN @@ -440,11 +445,11 @@ SUBROUTINE diag_bands_k() ! IF ( .NOT. lrot ) THEN ! - CALL rotate_wfc ( npwx, npw, nbnd, gstart, nbnd, evc, npol, okvan, evc, et(1,ik) ) + CALL rotate_wfc( npwx, npw, nbnd, gstart, nbnd, evc, npol, okvan, evc, et(1,ik) ) ! avg_iter = avg_iter + 1.D0 ! - END IF + ENDIF ! IF ( isolve == 1) then CALL ccgdiagg( hs_1psi, s_1psi, h_diag, & @@ -454,21 +459,21 @@ SUBROUTINE diag_bands_k() avg_iter = avg_iter + cg_iter ! ELSE -! BEWARE npol should be added to the arguments + ! BEWARE npol should be added to the arguments CALL ppcg_k( h_psi, s_psi, okvan, h_diag, & npwx, npw, nbnd, npol, evc, et(1,ik), btype(1,ik), & - 0.1d0*ethr, max_ppcg_iter, notconv, ppcg_iter, sbsize , rrstep, iter) + 0.1d0*ethr, max_ppcg_iter, notconv, ppcg_iter, sbsize , rrstep, iter ) ! avg_iter = avg_iter + ppcg_iter ! - END IF + ENDIF ntry = ntry + 1 ! ! ... exit condition ! IF ( test_exit_cond() ) EXIT CG_loop ! - END DO CG_loop + ENDDO CG_loop ! ELSE ! @@ -482,7 +487,7 @@ SUBROUTINE diag_bands_k() ! h_diag(1:npw, ipol) = g2kin(1:npw) + v_of_0 ! - END DO + ENDDO ! CALL usnldiag( npw, h_diag, s_diag ) ! @@ -492,7 +497,7 @@ SUBROUTINE diag_bands_k() ! lrot = ( iter == 1 ) ! - IF ( use_para_diag ) then + IF ( use_para_diag ) THEN ! CALL pcegterg( h_psi, s_psi, okvan, g_psi, & npw, npwx, nbnd, nbndx, npol, evc, ethr, & @@ -500,10 +505,10 @@ SUBROUTINE diag_bands_k() ! ELSE ! - CALL cegterg ( h_psi, s_psi, okvan, g_psi, & - npw, npwx, nbnd, nbndx, npol, evc, ethr, & - et(1,ik), btype(1,ik), notconv, lrot, dav_iter ) - END IF + CALL cegterg( h_psi, s_psi, okvan, g_psi, & + npw, npwx, nbnd, nbndx, npol, evc, ethr, & + et(1,ik), btype(1,ik), notconv, lrot, dav_iter ) + ENDIF ! avg_iter = avg_iter + dav_iter ! @@ -517,11 +522,11 @@ SUBROUTINE diag_bands_k() ! IF ( test_exit_cond() ) EXIT david_loop ! - END DO david_loop + ENDDO david_loop ! - END IF + ENDIF ! - IF ( lelfield .AND. okvan ) call deallocate_bec_type( bec_evcel) + IF ( lelfield .AND. okvan ) CALL deallocate_bec_type( bec_evcel ) ! RETURN ! @@ -530,9 +535,8 @@ END SUBROUTINE diag_bands_k !----------------------------------------------------------------------- FUNCTION test_exit_cond() !----------------------------------------------------------------------- - ! - ! ... this logical function is .TRUE. when iterative diagonalization - ! ... is converged + !! This logical function is .TRUE. when iterative diagonalization + !! is converged. ! IMPLICIT NONE ! @@ -548,10 +552,9 @@ END FUNCTION test_exit_cond END SUBROUTINE diag_bands ! !---------------------------------------------------------------------------- -SUBROUTINE c_bands_efield ( iter ) +SUBROUTINE c_bands_efield( iter ) !---------------------------------------------------------------------------- - ! - ! ... Driver routine for Hamiltonian diagonalization under an electric field + !! Driver routine for Hamiltonian diagonalization under an electric field. ! USE noncollin_module, ONLY : noncolin, npol USE kinds, ONLY : DP @@ -564,7 +567,10 @@ SUBROUTINE c_bands_efield ( iter ) ! IMPLICIT NONE ! - INTEGER, INTENT (in) :: iter + INTEGER, INTENT(IN) :: iter + !! iteration index + ! + ! ... local variables ! INTEGER :: inberry, ipol, ierr ! @@ -587,18 +593,18 @@ SUBROUTINE c_bands_efield ( iter ) !...set up electric field hermitean operator ! FLUSH(stdout) - if(.not.l3dstring) then + IF (.NOT.l3dstring) THEN CALL h_epsi_her_set (gdir, efield) - else - do ipol=1,3 + ELSE + DO ipol=1,3 CALL h_epsi_her_set(ipol, efield_cry(ipol)) - enddo - endif + ENDDO + ENDIF FLUSH(stdout) ! CALL c_bands( iter ) ! - END DO + ENDDO ! DEALLOCATE( fact_hepsi ) DEALLOCATE( evcelp ) @@ -609,11 +615,11 @@ SUBROUTINE c_bands_efield ( iter ) ! END SUBROUTINE c_bands_efield ! +!------------------------------------------------------------------------------ SUBROUTINE c_bands_nscf( ) !---------------------------------------------------------------------------- - ! - ! ... Driver routine for Hamiltonian diagonalization routines - ! ... specialized to non-self-consistent calculations (no electric field) + !! Driver routine for Hamiltonian diagonalization routines + !! specialized to non-self-consistent calculations (no electric field). ! USE kinds, ONLY : DP USE io_global, ONLY : stdout @@ -627,13 +633,15 @@ SUBROUTINE c_bands_nscf( ) USE control_flags, ONLY : ethr, restart, isolve, io_level, iverbosity USE ldaU, ONLY : lda_plus_u, U_projection, wfcU USE lsda_mod, ONLY : current_spin, lsda, isk - USE wavefunctions, ONLY : evc + USE wavefunctions, ONLY : evc USE mp_pools, ONLY : npool, kunit, inter_pool_comm USE mp, ONLY : mp_sum USE check_stop, ONLY : check_stop_now ! IMPLICIT NONE ! + ! ... local variables + ! REAL(DP) :: avg_iter, ethr_ ! average number of H*psi products INTEGER :: ik_, ik, nkdum, ios @@ -643,27 +651,28 @@ SUBROUTINE c_bands_nscf( ) ! REAL(DP), EXTERNAL :: get_clock ! + ! CALL start_clock( 'c_bands' ) ! ik_ = 0 avg_iter = 0.D0 - IF ( restart ) CALL restart_in_cbands(ik_, ethr, avg_iter, et ) + IF ( restart ) CALL restart_in_cbands( ik_, ethr, avg_iter, et ) ! ! ... If restarting, calculated wavefunctions have to be read from file ! DO ik = 1, ik_ - CALL get_buffer ( evc, nwordwfc, iunwfc, ik ) - END DO + CALL get_buffer( evc, nwordwfc, iunwfc, ik ) + ENDDO ! IF ( isolve == 0 ) THEN WRITE( stdout, '(5X,"Davidson diagonalization with overlap")' ) - ELSE IF ( isolve == 1 ) THEN - WRITE( stdout, '(5X,"CG style diagonalization")') - ELSE IF ( isolve == 2 ) THEN - WRITE( stdout, '(5X,"PPCG style diagonalization")') + ELSEIF ( isolve == 1 ) THEN + WRITE( stdout, '(5X,"CG style diagonalization")' ) + ELSEIF ( isolve == 2 ) THEN + WRITE( stdout, '(5X,"PPCG style diagonalization")' ) ELSE - CALL errore ( 'c_bands', 'invalid type of diagonalization', isolve) - END IF + CALL errore ( 'c_bands', 'invalid type of diagonalization', isolve ) + ENDIF ! ! ... For each k point (except those already calculated if restarting) ! ... diagonalizes the hamiltonian @@ -674,7 +683,7 @@ SUBROUTINE c_bands_nscf( ) ! current_k = ik IF ( lsda ) current_spin = isk(ik) - call g2_kin( ik ) + CALL g2_kin( ik ) ! ! ... More stuff needed by the hamiltonian: nonlocal projectors ! @@ -683,48 +692,49 @@ SUBROUTINE c_bands_nscf( ) ! ... Needed for LDA+U ! IF ( nks > 1 .AND. lda_plus_u .AND. (U_projection .NE. 'pseudo') ) & - CALL get_buffer ( wfcU, nwordwfcU, iunhub, ik ) + CALL get_buffer( wfcU, nwordwfcU, iunhub, ik ) ! ! ... calculate starting wavefunctions ! IF ( iverbosity > 0 .AND. npool == 1 ) THEN WRITE( stdout, 9001 ) ik, nks - ELSE IF ( iverbosity > 0 .AND. npool > 1 ) THEN + ELSEIF ( iverbosity > 0 .AND. npool > 1 ) THEN WRITE( stdout, 9002 ) ik, nks - END IF + ENDIF ! IF ( TRIM(starting_wfc) == 'file' ) THEN ! - CALL get_buffer ( evc, nwordwfc, iunwfc, ik ) + CALL get_buffer( evc, nwordwfc, iunwfc, ik ) ! ELSE ! - CALL init_wfc ( ik ) + CALL init_wfc( ik ) ! - END IF + ENDIF ! ! ... diagonalization of bands for k-point ik ! - call diag_bands ( 1, ik, avg_iter ) + CALL diag_bands( 1, ik, avg_iter ) ! ! ... save wave-functions (unless disabled in input) ! - IF ( io_level > -1 ) CALL save_buffer ( evc, nwordwfc, iunwfc, ik ) + IF ( io_level > -1 ) CALL save_buffer( evc, nwordwfc, iunwfc, ik ) ! ! ... beware: with pools, if the number of k-points on different ! ... pools differs, make sure that all processors are still in ! ... the loop on k-points before checking for stop condition ! nkdum = kunit * ( nkstot / kunit / npool ) - IF (ik .le. nkdum) THEN + IF (ik <= nkdum) THEN ! ! ... stop requested by user: save restart information, ! ... save wavefunctions to file ! - IF (check_stop_now()) THEN - CALL save_in_cbands(ik, ethr, avg_iter, et ) + IF ( check_stop_now() ) THEN + CALL save_in_cbands( ik, ethr, avg_iter, et ) RETURN - END IF + ENDIF + ! ENDIF ! ! report about timing @@ -734,7 +744,7 @@ SUBROUTINE c_bands_nscf( ) FLUSH( stdout ) ENDIF ! - END DO k_loop + ENDDO k_loop ! CALL mp_sum( avg_iter, inter_pool_comm ) avg_iter = avg_iter / nkstot diff --git a/PW/src/cdiagh.f90 b/PW/src/cdiagh.f90 index 099714b6ff..b777329384 100644 --- a/PW/src/cdiagh.f90 +++ b/PW/src/cdiagh.f90 @@ -9,9 +9,8 @@ !---------------------------------------------------------------------------- SUBROUTINE cdiagh( n, h, ldh, e, v ) !---------------------------------------------------------------------------- - ! - ! ... calculates all the eigenvalues and eigenvectors of a complex - ! ... hermitean matrix H. On output, the matrix is unchanged + !! Calculates all the eigenvalues and eigenvectors of a complex + !! hermitean matrix H. On output, the matrix is unchanged. ! USE kinds, ONLY : DP USE mp_bands, ONLY : nbgrp, me_bgrp, root_bgrp, intra_bgrp_comm @@ -21,16 +20,19 @@ SUBROUTINE cdiagh( n, h, ldh, e, v ) ! ! ... on INPUT ! - INTEGER :: n, ldh - ! dimension of the matrix to be diagonalized - ! leading dimension of h, as declared in the calling pgm unit + INTEGER :: n + !! Dimension of the matrix to be diagonalized + INTEGER :: ldh + !! Leading dimension of h, as declared in the calling pgm unit COMPLEX(DP) :: h(ldh,n) - ! matrix to be diagonalized + !! Matrix to be diagonalized ! ! ... on OUTPUT ! - REAL(DP) :: e(n) ! eigenvalues - COMPLEX(DP) :: v(ldh,n) ! eigenvectors (column-wise) + REAL(DP) :: e(n) + !! eigenvalues + COMPLEX(DP) :: v(ldh,n) + !! eigenvectors (column-wise) ! ! ... local variables for LAPACK ! diff --git a/PW/src/clean_pw.f90 b/PW/src/clean_pw.f90 index fe2c045119..d88064cdfb 100644 --- a/PW/src/clean_pw.f90 +++ b/PW/src/clean_pw.f90 @@ -11,15 +11,14 @@ !---------------------------------------------------------------------- SUBROUTINE clean_pw( lflag ) !---------------------------------------------------------------------- - ! - ! ... This routine deallocates dynamically allocated arrays - ! ... if lflag=.TRUE. all arrays are deallocated (end of calculation) - ! ... if lflag=.FALSE. ion-related variables and arrays allocated - ! ... at the very beginning of the calculation (routines iosys, read_file, - ! ... setup, read_pseudo) are not deallocated; all others arrays are. - ! ... This is used when a new calculation has to be performed (e.g. in neb, - ! ... phonon, vc-relax). Beware: the new calculation should not call any - ! ... of the routines mentioned above + !! This routine deallocates dynamically allocated arrays. + !! * If lflag=.TRUE. all arrays are deallocated (end of calculation); + !! * if lflag=.FALSE. ion-related variables and arrays allocated. + !! At the very beginning of the calculation (routines iosys, read_file, + !! setup, read_pseudo) are not deallocated; all others arrays are. + !! This is used when a new calculation has to be performed (e.g. in neb, + !! phonon, vc-relax). Beware: the new calculation should not CALL any + !! of the routines mentioned above. ! USE basis, ONLY : swfcatom USE cellmd, ONLY : lmovecell @@ -35,7 +34,7 @@ SUBROUTINE clean_pw( lflag ) vrs, kedtau, destroy_scf_type, vnew USE symm_base, ONLY : irt USE symme, ONLY : sym_rho_deallocate - USE wavefunctions, ONLY : evc, psic, psic_nc + USE wavefunctions, ONLY : evc, psic, psic_nc USE us, ONLY : qrad, tab, tab_at, tab_d2y, spline_ps USE uspp, ONLY : deallocate_uspp USE uspp_param, ONLY : upf @@ -69,8 +68,11 @@ SUBROUTINE clean_pw( lflag ) IMPLICIT NONE ! LOGICAL, INTENT(IN) :: lflag + !! see routine main comments. ! - INTEGER :: nt, nr1,nr2,nr3 + ! ... local variables + ! + INTEGER :: nt, nr1, nr2, nr3 ! IF ( lflag ) THEN ! @@ -79,75 +81,78 @@ SUBROUTINE clean_pw( lflag ) IF( ALLOCATED( upf ) ) THEN DO nt = 1, SIZE( upf ) CALL deallocate_pseudo_upf( upf( nt ) ) - END DO + ENDDO DEALLOCATE( upf ) - END IF - IF (ALLOCATED(msh)) DEALLOCATE (msh) - CALL deallocate_radial_grid(rgrid) + ENDIF + ! + IF (ALLOCATED(msh)) DEALLOCATE( msh ) + ! + CALL deallocate_radial_grid( rgrid ) ! CALL deallocate_ions_base() ! - IF ( ALLOCATED( force ) ) DEALLOCATE( force ) + IF ( ALLOCATED( force ) ) DEALLOCATE( force ) IF ( ALLOCATED( forcefield ) ) DEALLOCATE( forcefield ) - IF ( ALLOCATED( forcegate ) ) DEALLOCATE( forcegate ) - IF ( ALLOCATED( irt ) ) DEALLOCATE( irt ) + IF ( ALLOCATED( forcegate ) ) DEALLOCATE( forcegate ) + IF ( ALLOCATED( irt ) ) DEALLOCATE( irt ) ! CALL dealloca_london() CALL cleanup_xdm() CALL dftd3_clean() CALL deallocate_constraint() - CALL deallocate_tetra ( ) + CALL deallocate_tetra() ! - END IF + ENDIF ! CALL deallocate_bp_efield() ! - CALL deallocate_ldaU ( lflag ) + CALL deallocate_ldaU( lflag ) ! - IF ( ALLOCATED( f_inp ) .and. lflag ) DEALLOCATE( f_inp ) + IF ( ALLOCATED( f_inp ) .AND. lflag ) DEALLOCATE( f_inp ) ! ! ... arrays in gvect module ! - CALL deallocate_gvect(lmovecell) + CALL deallocate_gvect( lmovecell ) ! - CALL sym_rho_deallocate ( ) + CALL sym_rho_deallocate() ! ! ... arrays allocated in allocate_fft.f90 ( and never deallocated ) ! - call destroy_scf_type(rho) - call destroy_scf_type(v) - call destroy_scf_type(vnew) + CALL destroy_scf_type( rho ) + CALL destroy_scf_type( v ) + CALL destroy_scf_type( vnew ) + ! IF ( ALLOCATED( kedtau ) ) DEALLOCATE( kedtau ) - IF ( ALLOCATED( vltot ) ) DEALLOCATE( vltot ) - IF ( ALLOCATED( rho_core ) ) DEALLOCATE( rho_core ) + IF ( ALLOCATED( vltot ) ) DEALLOCATE( vltot ) + IF ( ALLOCATED( rho_core ) ) DEALLOCATE( rho_core ) IF ( ALLOCATED( rhog_core ) ) DEALLOCATE( rhog_core ) - IF ( ALLOCATED( psic ) ) DEALLOCATE( psic ) + IF ( ALLOCATED( psic ) ) DEALLOCATE( psic ) IF ( ALLOCATED( psic_nc ) ) DEALLOCATE( psic_nc ) - IF ( ALLOCATED( vrs ) ) DEALLOCATE( vrs ) - if (spline_ps) then - IF ( ALLOCATED( tab_d2y) ) DEALLOCATE( tab_d2y ) - endif + IF ( ALLOCATED( vrs ) ) DEALLOCATE( vrs ) + IF (spline_ps) THEN + IF ( ALLOCATED( tab_d2y) ) DEALLOCATE( tab_d2y ) + ENDIF ! ! ... arrays allocated in allocate_locpot.f90 ( and never deallocated ) ! - IF ( ALLOCATED( vloc ) ) DEALLOCATE( vloc ) + IF ( ALLOCATED( vloc ) ) DEALLOCATE( vloc ) IF ( ALLOCATED( cutoff_2D ) ) DEALLOCATE( cutoff_2D ) - IF ( ALLOCATED( lr_Vloc ) ) DEALLOCATE( lr_Vloc ) - IF ( ALLOCATED( strf ) ) DEALLOCATE( strf ) + IF ( ALLOCATED( lr_Vloc ) ) DEALLOCATE( lr_Vloc ) + IF ( ALLOCATED( strf ) ) DEALLOCATE( strf ) ! ! ... arrays allocated in allocate_nlpot.f90 ( and never deallocated ) ! - IF ( ALLOCATED( qrad ) ) DEALLOCATE( qrad ) - IF ( ALLOCATED( tab ) ) DEALLOCATE( tab ) + IF ( ALLOCATED( qrad ) ) DEALLOCATE( qrad ) + IF ( ALLOCATED( tab ) ) DEALLOCATE( tab ) IF ( ALLOCATED( tab_at ) ) DEALLOCATE( tab_at ) IF ( lspinorb ) THEN - IF ( ALLOCATED( fcoef ) ) DEALLOCATE( fcoef ) - END IF + IF ( ALLOCATED( fcoef ) ) DEALLOCATE( fcoef ) + ENDIF ! - CALL deallocate_igk ( ) + CALL deallocate_igk() CALL deallocate_uspp() CALL deallocate_gth( lflag ) - CALL deallocate_noncol() + CALL deallocate_noncol() ! ! ... arrays allocated in init_run.f90 ( and never deallocated ) ! @@ -169,6 +174,7 @@ SUBROUTINE clean_pw( lflag ) ! up with a different grid if FFT grids are re-initialized later. ! The following workaround restores the previous functionality. ! TODO: replace clean_pw with more fine-grained cleaning routines. + ! nr1 = dfftp%nr1; nr2 = dfftp%nr2; nr3 = dfftp%nr3 CALL fft_type_deallocate( dfftp ) dfftp%nr1 = nr1; dfftp%nr2 = nr2; dfftp%nr3 = nr3 @@ -191,12 +197,12 @@ SUBROUTINE clean_pw( lflag ) ! ! ... arrays for real-space algorithm ! - CALL deallocate_realsp() + CALL deallocate_realsp() ! ! for Wannier_ac - if (use_wannier) CALL wannier_clean() + IF (use_wannier) CALL wannier_clean() ! - CALL deallocate_exx ( ) + CALL deallocate_exx() ! IF (ts_vdw) CALL tsvdw_finalize() ! diff --git a/PW/src/close_files.f90 b/PW/src/close_files.f90 index a83fb098e8..ebe059ccd3 100644 --- a/PW/src/close_files.f90 +++ b/PW/src/close_files.f90 @@ -6,26 +6,25 @@ ! or http://www.gnu.org/copyleft/gpl.txt . ! !---------------------------------------------------------------------------- -SUBROUTINE close_files(lflag) +SUBROUTINE close_files( lflag ) !---------------------------------------------------------------------------- - ! - ! ... Close all files and synchronize processes for a new scf calculation. - ! - USE ldaU, ONLY : lda_plus_u, U_projection - USE control_flags, ONLY : io_level - USE fixed_occ, ONLY : one_atom_occupations - USE io_files, ONLY : prefix, iunwfc, iunsat, & - iunhub, iunefield, iunefieldm, iunefieldp, & - iunwfc_exx - USE buffers, ONLY : close_buffer - USE mp_images, ONLY : intra_image_comm - USE mp, ONLY : mp_barrier - USE wannier_new, ONLY : use_wannier - USE bp, ONLY : lelfield + !! Close all files and synchronize processes for a new scf calculation. + ! + USE ldaU, ONLY: lda_plus_u, U_projection + USE control_flags, ONLY: io_level + USE fixed_occ, ONLY: one_atom_occupations + USE io_files, ONLY: prefix, iunwfc, iunsat, & + iunhub, iunefield, iunefieldm, iunefieldp, & + iunwfc_exx + USE buffers, ONLY: close_buffer + USE mp_images, ONLY: intra_image_comm + USE mp, ONLY: mp_barrier + USE wannier_new, ONLY: use_wannier + USE bp, ONLY: lelfield ! IMPLICIT NONE ! - LOGICAL, intent(in) :: lflag + LOGICAL, INTENT(IN) :: lflag ! LOGICAL :: opnd ! @@ -40,23 +39,24 @@ SUBROUTINE close_files(lflag) ! ... close files associated with the EXX calculation ! INQUIRE( UNIT = iunwfc_exx, OPENED = opnd ) - IF ( opnd ) CALL close_buffer ( iunwfc_exx, 'DELETE' ) + IF ( opnd ) CALL close_buffer( iunwfc_exx, 'DELETE' ) ! ! ... iunsat contains the (orthogonalized) atomic wfcs * S ! ... iunhub as above, only for wavefcts having an associated Hubbard U ! - IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) THEN + IF ( lda_plus_u .AND. (U_projection /= 'pseudo') ) THEN IF ( io_level < 0 ) THEN - CALL close_buffer ( iunhub,'DELETE' ) + CALL close_buffer( iunhub,'DELETE' ) ELSE - CALL close_buffer ( iunhub,'KEEP' ) + CALL close_buffer( iunhub,'KEEP' ) END IF END IF + ! IF ( use_wannier .OR. one_atom_occupations ) THEN IF ( io_level < 0 ) THEN - CALL close_buffer ( iunsat,'DELETE' ) + CALL close_buffer( iunsat,'DELETE' ) ELSE - CALL close_buffer ( iunsat,'KEEP' ) + CALL close_buffer( iunsat,'KEEP' ) END IF END IF ! @@ -65,19 +65,20 @@ SUBROUTINE close_files(lflag) IF ( lelfield ) THEN ! IF ( io_level < 0 ) THEN - CALL close_buffer ( iunefield, 'DELETE' ) - CALL close_buffer ( iunefieldm,'DELETE' ) - CALL close_buffer ( iunefieldp,'DELETE' ) + CALL close_buffer( iunefield, 'DELETE' ) + CALL close_buffer( iunefieldm,'DELETE' ) + CALL close_buffer( iunefieldp,'DELETE' ) ELSE - CALL close_buffer ( iunefield, 'KEEP' ) - CALL close_buffer ( iunefieldm,'KEEP' ) - CALL close_buffer ( iunefieldp,'KEEP' ) + CALL close_buffer( iunefield, 'KEEP' ) + CALL close_buffer( iunefieldm,'KEEP' ) + CALL close_buffer( iunefieldp,'KEEP' ) ENDIF ! END IF ! CALL mp_barrier( intra_image_comm ) ! + ! RETURN ! END SUBROUTINE close_files diff --git a/PW/src/compute_becsum.f90 b/PW/src/compute_becsum.f90 index 399784771b..8da5854562 100644 --- a/PW/src/compute_becsum.f90 +++ b/PW/src/compute_becsum.f90 @@ -7,12 +7,11 @@ ! ! !---------------------------------------------------------------------------- -SUBROUTINE compute_becsum ( iflag ) +SUBROUTINE compute_becsum( iflag ) !---------------------------------------------------------------------------- - ! - ! ... Compute "becsum" = \sum_i w_i term - ! ... Output in module uspp and (PAW only) in rho%bec (symmetrized) - ! ... if iflag = 1, weights w_k are re-computed + !! Compute "becsum" = \sum_i w_i term. + !! Output in module uspp and (PAW only) in rho%bec (symmetrized) + !! if iflag = 1, weights w_k are re-computed. ! USE kinds, ONLY : DP USE control_flags, ONLY : gamma_only @@ -22,7 +21,7 @@ SUBROUTINE compute_becsum ( iflag ) USE buffers, ONLY : get_buffer USE scf, ONLY : rho USE uspp, ONLY : nkb, vkb, becsum, okvan - USE wavefunctions, ONLY : evc + USE wavefunctions, ONLY : evc USE noncollin_module, ONLY : noncolin USE wvfct, ONLY : nbnd, npwx, wg USE mp_pools, ONLY : inter_pool_comm @@ -37,7 +36,7 @@ SUBROUTINE compute_becsum ( iflag ) ! INTEGER, INTENT(IN) :: iflag ! - INTEGER :: ik,& ! counter on k points + INTEGER :: ik, & ! counter on k points ibnd_start, ibnd_end, this_bgrp_nbnd ! first, last and number of band in this bgrp ! ! @@ -47,26 +46,26 @@ SUBROUTINE compute_becsum ( iflag ) ! ! ... calculates weights of Kohn-Sham orbitals ! - IF ( iflag == 1) CALL weights ( ) + IF ( iflag == 1) CALL weights( ) ! becsum(:,:,:) = 0.D0 - CALL allocate_bec_type (nkb,nbnd, becp,intra_bgrp_comm) - call divide (inter_bgrp_comm, nbnd, ibnd_start, ibnd_end ) + CALL allocate_bec_type( nkb,nbnd, becp,intra_bgrp_comm ) + CALL divide( inter_bgrp_comm, nbnd, ibnd_start, ibnd_end ) this_bgrp_nbnd = ibnd_end - ibnd_start + 1 ! k_loop: DO ik = 1, nks ! IF ( lsda ) current_spin = isk(ik) IF ( nks > 1 ) & - CALL get_buffer ( evc, nwordwfc, iunwfc, ik ) + CALL get_buffer( evc, nwordwfc, iunwfc, ik ) IF ( nkb > 0 ) & CALL init_us_2( ngk(ik), igk_k(1,ik), xk(1,ik), vkb ) ! ! ... actual calculation is performed inside routine "sum_bec" ! - CALL sum_bec ( ik, current_spin, ibnd_start,ibnd_end,this_bgrp_nbnd ) + CALL sum_bec( ik, current_spin, ibnd_start, ibnd_end, this_bgrp_nbnd ) ! - END DO k_loop + ENDDO k_loop ! ! ... with distributed , sum over bands ! @@ -78,14 +77,14 @@ SUBROUTINE compute_becsum ( iflag ) ! ... For USPP there is no need to do this as becsums are only used ! ... to compute the density, which is symmetrized later. ! - IF( okpaw ) THEN + IF ( okpaw ) THEN rho%bec(:,:,:) = becsum(:,:,:) ! becsum is filled in sum_band_{k|gamma} - CALL mp_sum(rho%bec, inter_pool_comm ) - call mp_sum(rho%bec, inter_bgrp_comm ) - CALL PAW_symmetrize(rho%bec) + CALL mp_sum( rho%bec, inter_pool_comm ) + call mp_sum( rho%bec, inter_bgrp_comm ) + CALL PAW_symmetrize( rho%bec ) ENDIF ! - CALL deallocate_bec_type ( becp ) + CALL deallocate_bec_type( becp ) ! CALL stop_clock( 'compute_becsum' ) ! diff --git a/PW/src/compute_deff.f90 b/PW/src/compute_deff.f90 index 1c8a5463e2..252ff83d22 100644 --- a/PW/src/compute_deff.f90 +++ b/PW/src/compute_deff.f90 @@ -5,77 +5,109 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! -!--------------------------------------------------------------------------- -SUBROUTINE compute_deff(deff, et) -! -! This routine computes the effective value of the D-eS coefficients -! which appear often in many expressions in the US or PAW case. -! This routine is for the collinear case. -! -USE kinds, ONLY : DP -USE ions_base, ONLY : nsp, nat, ityp -USE uspp, ONLY : deeq, qq_at, okvan -USE uspp_param, ONLY : nhm -USE lsda_mod, ONLY : current_spin -IMPLICIT NONE - -INTEGER :: nt, na, is -REAL(DP), INTENT(OUT) :: deff(nhm, nhm, nat) -REAL(DP), INTENT(IN) :: et - -deff(:,:,:) = deeq(:,:,:,current_spin) -IF (okvan) THEN - DO nt = 1, nsp - DO na = 1, nat - IF ( ityp(na) == nt ) THEN - deff(:,:,na) = deff(:,:,na) - et*qq_at(:,:,na) - END IF - END DO - END DO -ENDIF -RETURN +!------------------------------------------------------------------------- +SUBROUTINE compute_deff( deff, et ) + !----------------------------------------------------------------------- + !! This routine computes the effective value of the D-eS coefficients + !! which appear often in many expressions in the US or PAW case. + !! This routine is for the collinear case. + ! + USE kinds, ONLY: DP + USE ions_base, ONLY: nsp, nat, ityp + USE uspp, ONLY: deeq, qq_at, okvan + USE uspp_param, ONLY: nhm + USE lsda_mod, ONLY: current_spin + ! + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: et + !! The eigenvalues of the hamiltonian + REAL(DP), INTENT(OUT) :: deff(nhm,nhm,nat) + !! Effective values of the D-eS coefficients + ! + ! ... local variables + ! + INTEGER :: nt, na, is + ! + deff(:,:,:) = deeq(:,:,:,current_spin) + ! + IF (okvan) THEN + ! + DO nt = 1, nsp + DO na = 1, nat + ! + IF ( ityp(na) == nt ) THEN + deff(:,:,na) = deff(:,:,na) - et*qq_at(:,:,na) + ENDIF + ! + ENDDO + ENDDO + ! + ENDIF + ! + ! + RETURN + ! END SUBROUTINE compute_deff ! -SUBROUTINE compute_deff_nc(deff, et) ! -! This routine computes the effective value of the D-eS coefficients -! which appears often in many expressions. This routine is for the -! noncollinear case. -! -USE kinds, ONLY : DP -USE ions_base, ONLY : nsp, nat, ityp -USE spin_orb, ONLY : lspinorb -USE noncollin_module, ONLY : noncolin, npol -USE uspp, ONLY : deeq_nc, qq_at, qq_so, okvan -USE uspp_param, ONLY : nhm -USE lsda_mod, ONLY : nspin -IMPLICIT NONE - -INTEGER :: nt, na, is, js, ijs -COMPLEX(DP), INTENT(OUT) :: deff(nhm, nhm, nat, nspin) -REAL(DP), INTENT(IN) :: et - -deff=deeq_nc -IF (okvan) THEN - DO nt = 1, nsp - DO na = 1, nat - IF ( ityp(na) == nt ) THEN - IF (lspinorb) THEN - deff(:,:,na,:) = deff(:,:,na,:) - et * qq_so(:,:,:,nt) - ELSE - ijs=0 - DO is=1,npol - DO js=1,npol - ijs=ijs+1 - IF (is==js) deff(:,:,na,ijs)=deff(:,:,na,ijs)-et*qq_at(:,:,na) - END DO - END DO - END IF - END IF - END DO - END DO -ENDIF - -RETURN +!--------------------------------------------------------------------------- +SUBROUTINE compute_deff_nc( deff, et ) + !------------------------------------------------------------------------- + !! This routine computes the effective value of the D-eS coefficients + !! which appears often in many expressions. This routine is for the + !! noncollinear case. + ! + USE kinds, ONLY: DP + USE ions_base, ONLY: nsp, nat, ityp + USE spin_orb, ONLY: lspinorb + USE noncollin_module, ONLY: noncolin, npol + USE uspp, ONLY: deeq_nc, qq_at, qq_so, okvan + USE uspp_param, ONLY: nhm + USE lsda_mod, ONLY: nspin + ! + IMPLICIT NONE + ! + REAL(DP), INTENT(IN) :: et + !! The eigenvalues of the hamiltonian + COMPLEX(DP), INTENT(OUT) :: deff(nhm,nhm,nat,nspin) + !! Effective values of the D-eS coefficients + ! + ! ... local variables + ! + INTEGER :: nt, na, is, js, ijs + ! + deff=deeq_nc + IF (okvan) THEN + ! + DO nt = 1, nsp + DO na = 1, nat + ! + IF ( ityp(na) == nt ) THEN + IF (lspinorb) THEN + deff(:,:,na,:) = deff(:,:,na,:) - et * qq_so(:,:,:,nt) + ELSE + ijs=0 + ! + DO is=1,npol + DO js=1,npol + ! + ijs=ijs+1 + IF (is==js) deff(:,:,na,ijs)=deff(:,:,na,ijs)-et*qq_at(:,:,na) + ! + ENDDO + ENDDO + ! + ENDIF + ENDIF + ! + ENDDO + ENDDO + ! + ENDIF + ! + ! + RETURN + ! END SUBROUTINE compute_deff_nc From 0627cecae2747e291584e358753df4779745e9b4 Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Thu, 27 Jun 2019 17:09:16 +0200 Subject: [PATCH 34/95] Ford-PW part 4 --- PW/src/c_phase_field.f90 | 855 ++++++++++++++-------------- PW/src/compute_qdipol.f90 | 156 ++--- PW/src/compute_qdipol_so.f90 | 87 +-- PW/src/compute_ux.f90 | 59 +- PW/src/coset.f90 | 92 +-- PW/src/deriv_drhoc.f90 | 92 +-- PW/src/divide_class.f90 | 1031 ++++++++++++++++++---------------- 7 files changed, 1226 insertions(+), 1146 deletions(-) diff --git a/PW/src/c_phase_field.f90 b/PW/src/c_phase_field.f90 index df01586766..b9d513f47c 100644 --- a/PW/src/c_phase_field.f90 +++ b/PW/src/c_phase_field.f90 @@ -5,56 +5,55 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! - -! this routine is used to calculate the electronic polarization -! when a finite electric field, described through the modern -! theory of the polarization, is applied. -! It is very similar to the routine c_phase in bp_c_phase -! however the numbering of the k-points in the strings is different - - -!======================================================================! - -SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir) - -!----------------------------------------------------------------------! - -! Geometric phase calculation along a strip of nppstr_3d(pdir) k-points -! averaged over a 2D grid of nkort k-points orthogonal to nppstr_3d(pdir) - -! --- Make use of the module with common information --- - USE kinds, ONLY : DP - USE io_global, ONLY : stdout, ionode, ionode_id - USE io_files, ONLY : iunwfc, nwordwfc,prefix,tmp_dir - USE buffers, ONLY : get_buffer - USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau, zv, atm - USE cell_base, ONLY : at, alat, tpiba, omega - USE constants, ONLY : pi, tpi - USE fft_base, ONLY : dfftp - USE gvect, ONLY : ngm, g, gcutm, ngm_g - USE uspp, ONLY : nkb, vkb, okvan - USE uspp_param, ONLY : upf, lmaxq, nbetam, nh, nhm - USE lsda_mod, ONLY : nspin - USE klist, ONLY : nelec, degauss, nks, xk, wk, ngk, igk_k - USE wvfct, ONLY : npwx, nbnd - USE noncollin_module, ONLY : noncolin, npol - USE bp, ONLY : nppstr_3d, mapgm_global, nx_el,phase_control +!============================================================================! +SUBROUTINE c_phase_field( el_pola, ion_pola, fact_pola, pdir ) + !-------------------------------------------------------------------------! + !! Geometric phase calculation along a strip of nppstr_3d(pdir) k-points + !! averaged over a 2D grid of nkort k-points orthogonal to nppstr_3d(pdir). + ! + !! This routine is used to calculate the electronic polarization + !! when a finite electric field, described through the modern + !! theory of the polarization, is applied. + !! It is very similar to the routine c_phase in bp_c_phase + !! however the numbering of the k-points in the strings is different. + ! + USE kinds, ONLY: DP + USE io_global, ONLY: stdout, ionode, ionode_id + USE io_files, ONLY: iunwfc, nwordwfc,prefix,tmp_dir + USE buffers, ONLY: get_buffer + USE ions_base, ONLY: nat, ntyp => nsp, ityp, tau, zv, atm + USE cell_base, ONLY: at, alat, tpiba, omega + USE constants, ONLY: pi, tpi + USE fft_base, ONLY: dfftp + USE gvect, ONLY: ngm, g, gcutm, ngm_g + USE uspp, ONLY: nkb, vkb, okvan + USE uspp_param, ONLY: upf, lmaxq, nbetam, nh, nhm + USE lsda_mod, ONLY: nspin + USE klist, ONLY: nelec, degauss, nks, xk, wk, ngk, igk_k + USE wvfct, ONLY: npwx, nbnd + USE noncollin_module, ONLY: noncolin, npol + USE bp, ONLY: nppstr_3d, mapgm_global, nx_el,phase_control USE fixed_occ - USE gvect, ONLY : ig_l2g - USE mp, ONLY : mp_sum, mp_bcast - USE mp_bands, ONLY : intra_bgrp_comm - USE mp_pools, ONLY : intra_pool_comm - USE becmod, ONLY : calbec,bec_type,allocate_bec_type,deallocate_bec_type - USE spin_orb, ONLY: lspinorb -! --- Avoid implicit definitions --- + USE gvect, ONLY: ig_l2g + USE mp, ONLY: mp_sum, mp_bcast + USE mp_bands, ONLY: intra_bgrp_comm + USE mp_pools, ONLY: intra_pool_comm + USE becmod, ONLY: calbec,bec_type,allocate_bec_type,deallocate_bec_type + USE spin_orb, ONLY: lspinorb + ! IMPLICIT NONE - - REAL(kind=DP), INTENT(out) :: el_pola!in output electronic polarization - REAL(kind=DP), INTENT(out) :: ion_pola!in output ionic polarization - REAL(kind=DP), INTENT(out) :: fact_pola!in outout the prefactor of the polarization - INTEGER, INTENT(in) :: pdir!direction on which the polarization is calculated - -! --- Internal definitions --- + ! + REAL(DP), INTENT(OUT) :: el_pola + !! electronic polarization + REAL(DP), INTENT(OUT) :: ion_pola + !! ionic polarization + REAL(DP), INTENT(OUT) :: fact_pola + !! the prefactor of the polarization + INTEGER, INTENT(IN) :: pdir + !! direction on which the polarization is calculated + ! + ! ... local variables + ! INTEGER :: i, ik INTEGER :: igk1(npwx) INTEGER :: igk0(npwx) @@ -96,128 +95,128 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir) INTEGER :: nstring INTEGER :: nt INTEGER :: nspinnc - REAL(dp) :: dk(3) - REAL(dp) :: dkmod - REAL(dp) :: el_loc - REAL(dp) :: eps - REAL(dp) :: fac - REAL(dp) :: gpar(3) - REAL(dp) :: gtr(3) - REAL(dp) :: gvec - REAL(dp), ALLOCATABLE :: loc_k(:) - REAL(dp), ALLOCATABLE :: pdl_elec(:) - REAL(dp), ALLOCATABLE :: phik(:) - REAL(dp) :: qrad_dk(nbetam,nbetam,lmaxq,ntyp) - REAL(dp) :: weight - REAL(dp) :: pola, pola_ion - REAL(dp), ALLOCATABLE :: wstring(:) - REAL(dp) :: ylm_dk(lmaxq*lmaxq) - REAL(dp) :: zeta_mod - COMPLEX(dp), ALLOCATABLE :: aux(:,:) - COMPLEX(dp), ALLOCATABLE :: aux0(:,:) + REAL(DP) :: dk(3) + REAL(DP) :: dkmod + REAL(DP) :: el_loc + REAL(DP) :: eps + REAL(DP) :: fac + REAL(DP) :: gpar(3) + REAL(DP) :: gtr(3) + REAL(DP) :: gvec + REAL(DP), ALLOCATABLE :: loc_k(:) + REAL(DP), ALLOCATABLE :: pdl_elec(:) + REAL(DP), ALLOCATABLE :: phik(:) + REAL(DP) :: qrad_dk(nbetam,nbetam,lmaxq,ntyp) + REAL(DP) :: weight + REAL(DP) :: pola, pola_ion + REAL(DP), ALLOCATABLE :: wstring(:) + REAL(DP) :: ylm_dk(lmaxq*lmaxq) + REAL(DP) :: zeta_mod + COMPLEX(DP), ALLOCATABLE :: aux(:,:) + COMPLEX(DP), ALLOCATABLE :: aux0(:,:) ! For noncollinear calculations - COMPLEX(dp), ALLOCATABLE :: aux_2(:,:) - COMPLEX(dp), ALLOCATABLE :: aux0_2(:,:) - COMPLEX(dp) , ALLOCATABLE :: cphik(:) - COMPLEX(dp) :: det - COMPLEX(dp) :: mat(nbnd,nbnd) - COMPLEX(dp) :: pref - COMPLEX(dp) :: q_dk(nhm,nhm,ntyp) - COMPLEX(dp) :: struc(nat) - COMPLEX(dp) :: zdotc - COMPLEX(dp) :: zeta - - COMPLEX(dp), ALLOCATABLE :: psi(:,:) - COMPLEX(dp), ALLOCATABLE :: psi1(:,:) - COMPLEX(dp) :: zeta_loc - - LOGICAL, ALLOCATABLE :: l_cal(:) ! flag for occupied/empty states + COMPLEX(DP), ALLOCATABLE :: aux_2(:,:) + COMPLEX(DP), ALLOCATABLE :: aux0_2(:,:) + COMPLEX(DP), ALLOCATABLE :: cphik(:) + COMPLEX(DP) :: det + COMPLEX(DP) :: mat(nbnd,nbnd) + COMPLEX(DP) :: pref + COMPLEX(DP) :: q_dk(nhm,nhm,ntyp) + COMPLEX(DP) :: struc(nat) + COMPLEX(DP) :: zdotc + COMPLEX(DP) :: zeta + ! + COMPLEX(DP), ALLOCATABLE :: psi(:,:) + COMPLEX(DP), ALLOCATABLE :: psi1(:,:) + COMPLEX(DP) :: zeta_loc + ! + LOGICAL, ALLOCATABLE :: l_cal(:) ! flag for occupied/empty states INTEGER, ALLOCATABLE :: map_g(:) - - REAL(dp) :: dkfact - COMPLEX(dp) :: zeta_tot - - LOGICAL :: l_para! if true new parallel treatment - COMPLEX(kind=DP) :: sca - COMPLEX(kind=DP), ALLOCATABLE :: aux_g(:) - COMPLEX(kind=DP), ALLOCATABLE :: aux_g_2(:) ! noncollinear case + ! + REAL(DP) :: dkfact + COMPLEX(DP) :: zeta_tot + ! + LOGICAL :: l_para ! if true new parallel treatment + COMPLEX(DP) :: sca + COMPLEX(DP), ALLOCATABLE :: aux_g(:) + COMPLEX(DP), ALLOCATABLE :: aux_g_2(:) ! noncollinear case TYPE(bec_type) :: becp0, becp_bp COMPLEX(DP), ALLOCATABLE :: q_dk_so(:,:,:,:) - - COMPLEX(DP), ALLOCATABLE :: zetas(:,:)!string data for phase control + ! + COMPLEX(DP), ALLOCATABLE :: zetas(:,:) ! string data for phase control INTEGER, EXTERNAL :: find_free_unit INTEGER :: iun_phase INTEGER :: idumm1, idumm2 - REAL(kind=DP) :: zetam + REAL(DP) :: zetam CHARACTER(len=80) :: iun_name - -! ------------------------------------------------------------------------- ! -! INITIALIZATIONS -! ------------------------------------------------------------------------- ! - - call start_clock('c_phase_field') - - SELECT CASE( pdir) - CASE( 1) + ! + ! ------------------------------------------------------------------------- ! + ! INITIALIZATIONS ! + ! ------------------------------------------------------------------------- ! + ! + CALL start_clock( 'c_phase_field' ) + ! + SELECT CASE( pdir ) + CASE( 1 ) iun_name='1' - CASE( 2) + CASE( 2 ) iun_name='2' - CASE( 3) + CASE( 3 ) iun_name='3' END SELECT - - - ALLOCATE (psi1(npol*npwx,nbnd)) - ALLOCATE (psi(npol*npwx,nbnd)) - ALLOCATE (aux(ngm,nbnd)) - ALLOCATE (aux0(ngm,nbnd)) + ! + ALLOCATE( psi1(npol*npwx,nbnd) ) + ALLOCATE( psi(npol*npwx,nbnd) ) + ALLOCATE( aux(ngm,nbnd) ) + ALLOCATE( aux0(ngm,nbnd) ) nspinnc=nspin IF (noncolin) THEN nspinnc=1 - ALLOCATE (aux_2(ngm,nbnd)) - ALLOCATE (aux0_2(ngm,nbnd)) + ALLOCATE( aux_2(ngm,nbnd) ) + ALLOCATE( aux0_2(ngm,nbnd) ) END IF - ALLOCATE (map_g(npwx)) - ALLOCATE (l_cal(nbnd)) - if(pdir==3) then - l_para=.false. - else - l_para=.true. - endif - - - if(okvan) then - call allocate_bec_type(nkb,nbnd,becp0) - call allocate_bec_type(nkb,nbnd,becp_bp) - IF (lspinorb) ALLOCATE(q_dk_so(nhm,nhm,4,ntyp)) - endif - - + ALLOCATE( map_g(npwx) ) + ALLOCATE( l_cal(nbnd) ) + ! + IF ( pdir==3 ) THEN + l_para=.FALSE. + ELSE + l_para=.TRUE. + ENDIF + ! + ! + IF (okvan) THEN + CALL allocate_bec_type( nkb, nbnd, becp0 ) + CALL allocate_bec_type( nkb, nbnd, becp_bp ) + IF (lspinorb) ALLOCATE( q_dk_so(nhm,nhm,4,ntyp) ) + ENDIF + ! + ! pola=0.d0 !set to 0 electronic polarization zeta_tot=(1.d0,0.d0) - -! --- Check that we are working with an insulator with no empty bands --- - IF ( degauss > 0.0_dp ) CALL errore('c_phase_field', & - 'Polarization only for insulators and no empty bands',1) - + ! + ! --- Check that we are working with an insulator with no empty bands --- + IF ( degauss > 0.0_DP ) CALL errore( 'c_phase_field', & + 'Polarization only for insulators and no empty bands', 1 ) + ! ! --- Define a small number --- - eps=1.0E-6_dp - -! --- Recalculate FFT correspondence (see ggen.f90) --- - ALLOCATE (ln (-dfftp%nr1:dfftp%nr1, -dfftp%nr2:dfftp%nr2, -dfftp%nr3:dfftp%nr3) ) + eps=1.0E-6_DP + ! + ! --- Recalculate FFT correspondence (see ggen.f90) --- + ALLOCATE( ln(-dfftp%nr1:dfftp%nr1, -dfftp%nr2:dfftp%nr2, -dfftp%nr3:dfftp%nr3) ) DO ng=1,ngm - mk1=nint(g(1,ng)*at(1,1)+g(2,ng)*at(2,1)+g(3,ng)*at(3,1)) - mk2=nint(g(1,ng)*at(1,2)+g(2,ng)*at(2,2)+g(3,ng)*at(3,2)) - mk3=nint(g(1,ng)*at(1,3)+g(2,ng)*at(2,3)+g(3,ng)*at(3,3)) + mk1=NINT( g(1,ng)*at(1,1)+g(2,ng)*at(2,1)+g(3,ng)*at(3,1) ) + mk2=NINT( g(1,ng)*at(1,2)+g(2,ng)*at(2,2)+g(3,ng)*at(3,2) ) + mk3=NINT( g(1,ng)*at(1,3)+g(2,ng)*at(2,3)+g(3,ng)*at(3,3) ) ln(mk1,mk2,mk3) = ng END DO - - if (okvan) then -! --- Initialize arrays --- + ! + IF (okvan) THEN + ! --- Initialize arrays --- jkb_bp=0 DO nt=1,ntyp DO na=1,nat - IF (ityp(na).eq.nt) THEN + IF (ityp(na) == nt) THEN DO i=1, nh(nt) jkb_bp=jkb_bp+1 nkbtona(jkb_bp) = na @@ -226,257 +225,262 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir) END IF END DO END DO - endif -! --- Get the number of strings --- + ENDIF + ! --- Get the number of strings --- nstring=nks/nppstr_3d(pdir) nkort=nstring/(nspinnc) ! Include noncollinear case - -! --- Allocate memory for arrays --- - ALLOCATE(phik(nstring)) - ALLOCATE(loc_k(nstring)) - ALLOCATE(cphik(nstring)) - ALLOCATE(wstring(nstring)) - ALLOCATE(pdl_elec(nstring)) - ALLOCATE(mod_elec(nstring)) - - ALLOCATE(zetas(nkort,nspinnc)) -! ------------------------------------------------------------------------- ! -! electronic polarization: set values for k-points strings ! -! ------------------------------------------------------------------------- ! - -! --- Find vector along strings --- - if(nppstr_3d(pdir) .ne. 1) then - gpar(1)=(xk(1,nx_el(nppstr_3d(pdir),pdir))-xk(1,nx_el(1,pdir)))*& - &DBLE(nppstr_3d(pdir))/DBLE(nppstr_3d(pdir)-1) - gpar(2)=(xk(2,nx_el(nppstr_3d(pdir),pdir))-xk(2,nx_el(1,pdir)))*& - &DBLE(nppstr_3d(pdir))/DBLE(nppstr_3d(pdir)-1) - gpar(3)=(xk(3,nx_el(nppstr_3d(pdir),pdir))-xk(3,nx_el(1,pdir)))*& - &DBLE(nppstr_3d(pdir))/DBLE(nppstr_3d(pdir)-1) - gvec=dsqrt(gpar(1)**2+gpar(2)**2+gpar(3)**2)*tpiba - else - gpar(1)=0.d0 - gpar(2)=0.d0 - gpar(3)=0.d0 - gpar(pdir)=1.d0/at(pdir,pdir)! - gvec=tpiba/sqrt(at(pdir,1)**2.d0+at(pdir,2)**2.d0+at(pdir,3)**2.d0) - endif -! --- Find vector between consecutive points in strings --- - if(nppstr_3d(pdir).ne.1) then ! orthorhombic cell - dk(1)=xk(1,nx_el(2,pdir))-xk(1,nx_el(1,pdir)) - dk(2)=xk(2,nx_el(2,pdir))-xk(2,nx_el(1,pdir)) - dk(3)=xk(3,nx_el(2,pdir))-xk(3,nx_el(1,pdir)) - dkmod=SQRT(dk(1)**2+dk(2)**2+dk(3)**2)*tpiba - else ! Gamma point case, only cubic cell for now - dk(1)=0.d0 - dk(2)=0.d0 - dk(3)=0.d0 - dk(pdir)=1.d0/at(pdir,pdir) - dkmod=tpiba/sqrt(at(pdir,1)**2.d0+at(pdir,2)**2.d0+at(pdir,3)**2.d0) - endif - -! ------------------------------------------------------------------------- ! -! electronic polarization: weight strings ! -! ------------------------------------------------------------------------- ! - -! --- Calculate string weights, normalizing to 1 (no spin) or 1+1 (spin) --- + ! + ! --- Allocate memory for arrays --- + ALLOCATE( phik(nstring) ) + ALLOCATE( loc_k(nstring) ) + ALLOCATE( cphik(nstring) ) + ALLOCATE( wstring(nstring) ) + ALLOCATE( pdl_elec(nstring) ) + ALLOCATE( mod_elec(nstring) ) + + ALLOCATE( zetas(nkort,nspinnc) ) + ! ------------------------------------------------------------------------- ! + ! electronic polarization: set values for k-points strings ! + ! ------------------------------------------------------------------------- ! + + ! --- Find vector along strings --- + IF ( nppstr_3d(pdir) /= 1) THEN + gpar(1) = (xk(1,nx_el(nppstr_3d(pdir),pdir))-xk(1,nx_el(1,pdir)))*& + &DBLE(nppstr_3d(pdir))/DBLE(nppstr_3d(pdir)-1) + gpar(2) = (xk(2,nx_el(nppstr_3d(pdir),pdir))-xk(2,nx_el(1,pdir)))*& + &DBLE(nppstr_3d(pdir))/DBLE(nppstr_3d(pdir)-1) + gpar(3) = (xk(3,nx_el(nppstr_3d(pdir),pdir))-xk(3,nx_el(1,pdir)))*& + &DBLE(nppstr_3d(pdir))/DBLE(nppstr_3d(pdir)-1) + gvec = DSQRT( gpar(1)**2+gpar(2)**2+gpar(3)**2 )*tpiba + ELSE + gpar(1) = 0.d0 + gpar(2) = 0.d0 + gpar(3) = 0.d0 + gpar(pdir) = 1.d0 / at(pdir,pdir) + gvec = tpiba / SQRT( at(pdir,1)**2.d0 + at(pdir,2)**2.d0 + at(pdir,3)**2.d0 ) + ENDIF + ! --- Find vector between consecutive points in strings --- + IF ( nppstr_3d(pdir) /= 1) THEN ! orthorhombic cell + dk(1) = xk(1,nx_el(2,pdir))-xk(1,nx_el(1,pdir)) + dk(2) = xk(2,nx_el(2,pdir))-xk(2,nx_el(1,pdir)) + dk(3) = xk(3,nx_el(2,pdir))-xk(3,nx_el(1,pdir)) + dkmod = SQRT( dk(1)**2 + dk(2)**2 + dk(3)**2 )*tpiba + ELSE ! Gamma point case, only cubic cell for now + dk(1) = 0.d0 + dk(2) = 0.d0 + dk(3) = 0.d0 + dk(pdir) = 1.d0 / at(pdir,pdir) + dkmod = tpiba / SQRT( at(pdir,1)**2.d0 + at(pdir,2)**2.d0 + at(pdir,3)**2.d0 ) + ENDIF + ! + ! ------------------------------------------------------------------------- ! + ! electronic polarization: weight strings ! + ! ------------------------------------------------------------------------- ! + ! + ! --- Calculate string weights, normalizing to 1 (no spin) or 1+1 (spin) --- DO is=1,nspinnc ! Include noncollinear case - weight=0.0_dp + weight = 0.0_dp DO kort=1,nkort - istring=kort+(is-1)*nkort - wstring(istring)=wk(nppstr_3d(pdir)*istring) - weight=weight+wstring(istring) + istring = kort + (is-1)*nkort + wstring(istring) = wk(nppstr_3d(pdir)*istring) + weight = weight + wstring(istring) END DO DO kort=1,nkort - istring=kort+(is-1)*nkort - wstring(istring)=wstring(istring)/weight + istring = kort+(is-1)*nkort + wstring(istring) = wstring(istring) / weight END DO END DO - -! ------------------------------------------------------------------------- ! -! electronic polarization: structure factor ! -! ------------------------------------------------------------------------- ! - -! --- Calculate structure factor e^{-i dk*R} --- - + ! + ! ------------------------------------------------------------------------- ! + ! electronic polarization: structure factor ! + ! ------------------------------------------------------------------------- ! + ! + ! --- Calculate structure factor e^{-i dk*R} --- + ! DO na=1,nat - fac=(dk(1)*tau(1,na)+dk(2)*tau(2,na)+dk(3)*tau(3,na))*tpi - struc(na)=CMPLX(cos(fac),-sin(fac),kind=DP) + fac = (dk(1)*tau(1,na)+dk(2)*tau(2,na)+dk(3)*tau(3,na))*tpi + struc(na) = CMPLX( COS(fac),-SIN(fac),KIND=DP) END DO - -! ------------------------------------------------------------------------- ! -! electronic polarization: form factor ! -! ------------------------------------------------------------------------- ! - if(okvan) then -! --- Calculate Bessel transform of Q_ij(|r|) at dk [Q_ij^L(|r|)] --- + ! + ! ------------------------------------------------------------------------- ! + ! electronic polarization: form factor ! + ! ------------------------------------------------------------------------- ! + IF (okvan) THEN + ! --- Calculate Bessel transform of Q_ij(|r|) at dk [Q_ij^L(|r|)] --- CALL calc_btq(dkmod,qrad_dk,0) - -! --- Calculate the q-space real spherical harmonics at dk [Y_LM] --- + ! + ! --- Calculate the q-space real spherical harmonics at dk [Y_LM] --- dkmod = dk(1)**2+dk(2)**2+dk(3)**2 CALL ylmr2(lmaxq*lmaxq, 1, dk, dkmod, ylm_dk) - -! --- Form factor: 4 pi sum_LM c_ij^LM Y_LM(Omega) Q_ij^L(|r|) --- + ! + ! --- Form factor: 4 pi sum_LM c_ij^LM Y_LM(Omega) Q_ij^L(|r|) --- q_dk=(0.d0,0.d0) DO np =1, ntyp - if( upf(np)%tvanp ) then + IF ( upf(np)%tvanp ) THEN DO iv = 1, nh(np) DO jv = iv, nh(np) - call qvan3(iv,jv,np,pref,ylm_dk,qrad_dk) + CALL qvan3( iv,jv,np,pref,ylm_dk,qrad_dk ) q_dk(iv,jv,np) = omega*pref q_dk(jv,iv,np) = omega*pref ENDDO ENDDO - endif + ENDIF ENDDO IF (lspinorb) CALL transform_qq_so(q_dk,q_dk_so) - endif - -! ------------------------------------------------------------------------- ! -! electronic polarization: strings phases ! -! ------------------------------------------------------------------------- ! - + ENDIF + ! + ! ------------------------------------------------------------------------- ! + ! electronic polarization: strings phases ! + ! ------------------------------------------------------------------------- ! + ! el_loc=0.d0 kpoint=0 zeta=(1.d0,0.d0) - - if(ionode .and. phase_control>0) then + ! + if(ionode .AND. phase_control>0) THEN iun_phase=find_free_unit() - if(phase_control==1) THEN - OPEN( iun_phase, file=trim(tmp_dir)//trim(prefix)//'.phase.data'//trim(iun_name),status='unknown') + IF ( phase_control==1 ) THEN + OPEN( iun_phase, file=TRIM(tmp_dir)//TRIM(prefix)//'.phase.data'//TRIM(iun_name),status='unknown') ELSE - OPEN( iun_phase, file=trim(tmp_dir)//trim(prefix)//'.phase.data'//trim(iun_name),status='OLD') - do is=1,nspinnc - do kort=1,nkort + OPEN( iun_phase, file=TRIM(tmp_dir)//TRIM(prefix)//'.phase.data'//TRIM(iun_name),status='OLD') + DO is=1,nspinnc + DO kort=1,nkort read(iun_phase,*) idumm1,idumm2,zetas(kort,is) - zetam=dble(conjg(zetas(kort,is))*zetas(kort,is)) - zetam=1.d0/dsqrt(zetam) - zetas(kort,is)=conjg(zetam*zetas(kort,is)) - enddo - enddo + zetam = DBLE( CONJG(zetas(kort,is))*zetas(kort,is) ) + zetam = 1.d0 / DSQRT( zetam ) + zetas(kort,is) = CONJG( zetam*zetas(kort,is) ) + ENDDO + ENDDO ENDIF - endif + ENDIF ! ! FIXME: not sure which is the proper communicator here ! - if(phase_control==2) & + IF (phase_control==2) & CALL mp_bcast(zetas, ionode_id, intra_pool_comm ) - -! --- Start loop over spin --- + ! + ! --- Start loop over spin --- DO is=1,nspinnc ! Include noncollinear case - + ! ! l_cal(n) = .true./.false. if n-th state is occupied/empty DO nb = 1, nbnd IF ( nspin == 2 .AND. tfixed_occ) THEN l_cal(nb) = ( f_inp(nb,is) /= 0.0_dp ) ELSE IF (noncolin) THEN - l_cal(nb) = ( nb <= NINT ( nelec) ) + l_cal(nb) = ( nb <= NINT( nelec) ) ELSE - l_cal(nb) = ( nb <= NINT ( nelec/2.0_dp ) ) + l_cal(nb) = ( nb <= NINT( nelec/2.0_dp ) ) ENDIF ENDIF END DO - -! --- Start loop over orthogonal k-points --- + ! + ! --- Start loop over orthogonal k-points --- + ! DO kort=1,nkort zeta_loc=(1.d0,0.d0) -! --- Index for this string --- + ! --- Index for this string --- istring=kort+(is-1)*nkort - -! --- Initialize expectation value of the phase operator --- - + ! + ! --- Initialize expectation value of the phase operator --- + ! zeta_mod = 1.d0 - -! --- Start loop over parallel k-points --- + ! + ! --- Start loop over parallel k-points --- DO kpar = 1,nppstr_3d(pdir)+1 - -! --- Set index of k-point --- + ! + ! --- Set index of k-point --- kpoint = kpoint + 1 - -! --- Calculate dot products between wavefunctions and betas --- + ! + ! --- Calculate dot products between wavefunctions and betas --- + ! IF (kpar /= 1 ) THEN - -! --- Dot wavefunctions and betas for PREVIOUS k-point --- + ! + ! --- Dot wavefunctions and betas for PREVIOUS k-point --- + ! ik = nx_el(kpoint-1,pdir) npw0 = ngk(ik) igk0(:)= igk_k(:,ik) - CALL get_buffer (psi,nwordwfc,iunwfc,nx_el(kpoint-1,pdir)) - if (okvan) then - CALL init_us_2 (npw0,igk0,xk(1,nx_el(kpoint-1,pdir)),vkb) + CALL get_buffer( psi,nwordwfc,iunwfc,nx_el(kpoint-1,pdir) ) + IF (okvan) THEN + CALL init_us_2( npw0,igk0,xk(1,nx_el(kpoint-1,pdir)),vkb ) CALL calbec( npw0, vkb, psi, becp0) - endif -! --- Dot wavefunctions and betas for CURRENT k-point --- + ENDIF + ! + ! --- Dot wavefunctions and betas for CURRENT k-point --- + ! IF (kpar /= (nppstr_3d(pdir)+1)) THEN ik = nx_el(kpoint,pdir) npw1 = ngk(ik) igk1(:)= igk_k(:,ik) - CALL get_buffer (psi1,nwordwfc,iunwfc,nx_el(kpoint,pdir)) - if(okvan) then - CALL init_us_2 (npw1,igk1,xk(1,nx_el(kpoint,pdir)),vkb) - CALL calbec( npw1, vkb, psi1, becp_bp) - endif + CALL get_buffer( psi1,nwordwfc,iunwfc,nx_el(kpoint,pdir) ) + IF (okvan) THEN + CALL init_us_2( npw1,igk1,xk(1,nx_el(kpoint,pdir)),vkb ) + CALL calbec( npw1, vkb, psi1, becp_bp ) + ENDIF ELSE kstart = kpoint-(nppstr_3d(pdir)+1)+1 ik = nx_el(kstart,pdir) npw1 = ngk(ik) igk1(:)= igk_k(:,ik) - CALL get_buffer (psi1,nwordwfc,iunwfc,nx_el(kstart,pdir)) - if(okvan) then - CALL init_us_2 (npw1,igk1,xk(1,nx_el(kstart,pdir)),vkb) - CALL calbec( npw1, vkb, psi1, becp_bp) - endif + CALL get_buffer( psi1,nwordwfc,iunwfc,nx_el(kstart,pdir) ) + IF (okvan) THEN + CALL init_us_2( npw1,igk1,xk(1,nx_el(kstart,pdir)),vkb ) + CALL calbec( npw1, vkb, psi1, becp_bp ) + ENDIF ENDIF - -! --- Matrix elements calculation --- - - IF (kpar == (nppstr_3d(pdir)+1) .and. .not.l_para) THEN + ! + ! --- Matrix elements calculation --- + ! + IF (kpar == (nppstr_3d(pdir)+1) .AND. .NOT.l_para) THEN map_g(:) = 0 - do ig=1,npw1 -! --- If k'=k+G_o, the relation psi_k+G_o (G-G_o) --- -! --- = psi_k(G) is used, gpar=G_o, gtr = G-G_o --- - + DO ig = 1, npw1 + ! --- If k'=k+G_o, the relation psi_k+G_o (G-G_o) --- + ! --- = psi_k(G) is used, gpar=G_o, gtr = G-G_o --- + ! gtr(1)=g(1,igk1(ig)) - gpar(1) gtr(2)=g(2,igk1(ig)) - gpar(2) gtr(3)=g(3,igk1(ig)) - gpar(3) -! --- Find crystal coordinates of gtr, n1,n2,n3 --- -! --- and the position ng in the ngm array --- + ! --- Find crystal coordinates of gtr, n1,n2,n3 --- + ! --- and the position ng in the ngm array --- IF (gtr(1)**2+gtr(2)**2+gtr(3)**2 <= gcutm) THEN - n1=NINT(gtr(1)*at(1,1)+gtr(2)*at(2,1) & - +gtr(3)*at(3,1)) - n2=NINT(gtr(1)*at(1,2)+gtr(2)*at(2,2) & - +gtr(3)*at(3,2)) - n3=NINT(gtr(1)*at(1,3)+gtr(2)*at(2,3) & - +gtr(3)*at(3,3)) - ng=ln(n1,n2,n3) + n1 = NINT(gtr(1)*at(1,1)+gtr(2)*at(2,1) & + +gtr(3)*at(3,1)) + n2 = NINT(gtr(1)*at(1,2)+gtr(2)*at(2,2) & + +gtr(3)*at(3,2)) + n3 = NINT(gtr(1)*at(1,3)+gtr(2)*at(2,3) & + +gtr(3)*at(3,3)) + ng = ln(n1,n2,n3) IF ( (ABS(g(1,ng)-gtr(1)) > eps) .OR. & (ABS(g(2,ng)-gtr(2)) > eps) .OR. & (ABS(g(3,ng)-gtr(3)) > eps) ) THEN - WRITE(6,*) ' error: translated G=', & + WRITE (6,*) ' error: translated G=', & gtr(1),gtr(2),gtr(3), & & ' with crystal coordinates',n1,n2,n3, & & ' corresponds to ng=',ng,' but G(ng)=', & & g(1,ng),g(2,ng),g(3,ng) - WRITE(6,*) ' probably because G_par is NOT', & + WRITE (6,*) ' probably because G_par is NOT', & & ' a reciprocal lattice vector ' - WRITE(6,*) ' Possible choices as smallest ', & + WRITE (6,*) ' Possible choices as smallest ', & ' G_par:' DO i=1,50 - WRITE(6,*) ' i=',i,' G=', & + WRITE (6,*) ' i=',i,' G=', & g(1,i),g(2,i),g(3,i) ENDDO STOP ENDIF ELSE - WRITE(6,*) ' |gtr| > gcutm for gtr=', & + WRITE (6,*) ' |gtr| > gcutm for gtr=', & gtr(1),gtr(2),gtr(3) STOP END IF map_g(ig)=ng - enddo + ENDDO ENDIF mat=(0.d0,0.d0) aux=(0.d0,0.d0) - if(noncolin) aux_2=(0.d0,0.d0) + IF ( noncolin ) aux_2=(0.d0,0.d0) DO mb=1,nbnd IF ( .NOT. l_cal(mb) ) THEN mat(mb,mb)=(0.d0, 0.d0) @@ -492,12 +496,12 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir) IF (noncolin) aux_2(map_g(ig),mb)=psi1(ig+npwx,mb) ENDDO ELSE -! allocate global array + ! allocate global array ALLOCATE (aux_g(ngm_g)) IF(noncolin) ALLOCATE (aux_g_2(ngm_g)) aux_g=(0.d0,0.d0) IF(noncolin) aux_g_2=(0.d0,0.d0) -! put psi1 on global array + ! put psi1 on global array DO ig=1,npw1 aux_g(mapgm_global(ig_l2g(igk1(ig)),pdir))=psi1(ig,mb) IF(noncolin) aux_g_2(mapgm_global(ig_l2g(igk1(ig)),pdir))=psi1(ig+npwx,mb) @@ -514,15 +518,15 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir) END IF END DO aux0=(0.d0,0.d0) - if(noncolin) aux0_2=(0.d0,0.d0) + IF (noncolin) aux0_2 = (0.d0,0.d0) DO nb=1,nbnd DO ig=1,npw0 - aux0(igk0(ig),nb)=psi(ig,nb) - IF(noncolin) aux0_2(igk0(ig),nb)=psi(ig+npwx,nb) + aux0(igk0(ig),nb) = psi(ig,nb) + IF (noncolin) aux0_2(igk0(ig),nb) = psi(ig+npwx,nb) END DO ENDDO - call ZGEMM('C','N',nbnd,nbnd,ngm,(1.d0,0.d0),aux0,ngm,aux,ngm,(0.d0,0.d0),mat,nbnd) - if(noncolin) call ZGEMM('C','N',nbnd,nbnd,ngm,(1.d0,0.d0),aux0_2,ngm,aux_2,ngm,(1.d0,0.d0),mat,nbnd) + CALL ZGEMM('C','N',nbnd,nbnd,ngm,(1.d0,0.d0),aux0,ngm,aux,ngm,(0.d0,0.d0),mat,nbnd) + IF (noncolin) CALL ZGEMM('C','N',nbnd,nbnd,ngm,(1.d0,0.d0),aux0_2,ngm,aux_2,ngm,(1.d0,0.d0),mat,nbnd) CALL mp_sum( mat, intra_bgrp_comm ) DO mb=1,nbnd DO nb=1,nbnd @@ -535,14 +539,13 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir) ENDIF ENDDO END DO -! - - - -! --- Calculate the augmented part: ij=KB projectors, --- -! --- R=atom index: SUM_{ijR} q(ijR) --- -! --- e^i(k-k')*R = --- -! --- also = = becp^* --- + ! + ! + ! --- Calculate the augmented part: ij=KB projectors, --- + ! --- R=atom index: SUM_{ijR} q(ijR) --- + ! --- e^i(k-k')*R = --- + ! --- also = = becp^* --- + ! IF (okvan) THEN DO mb=1,nbnd DO nb=1,nbnd @@ -555,7 +558,7 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir) nhjkbm = nh(np) jkb1 = jkb - nhjkb DO j = 1,nhjkbm - if(lspinorb) then + IF (lspinorb) THEN pref = pref+CONJG(becp0%nc(jkb,1,nb))*becp_bp%nc(jkb1+j,1,mb) & *q_dk_so(nhjkb,j,1,np)*struc(na) pref = pref+CONJG(becp0%nc(jkb,1,nb))*becp_bp%nc(jkb1+j,2,mb) & @@ -564,133 +567,133 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir) *q_dk_so(nhjkb,j,3,np)*struc(na) pref = pref+CONJG(becp0%nc(jkb,2,nb))*becp_bp%nc(jkb1+j,2,mb) & *q_dk_so(nhjkb,j,4,np)*struc(na) - - else - + ! + ELSE + ! pref = pref+CONJG(becp0%k(jkb,nb))*becp_bp%k(jkb1+j,mb) & *q_dk(nhjkb,j,np)*struc(na) - endif + ENDIF ENDDO ENDDO - + ! mat(nb,mb) = mat(nb,mb) + pref ENDIF ENDDO ENDDO ENDIF - -! --- Calculate matrix determinant --- - - call ZGETRF(nbnd,nbnd,mat,nbnd,ivpt,info) - CALL errore('c_phase_field','error in zgetrf',abs(info)) + ! + ! --- Calculate matrix determinant --- + ! + CALL ZGETRF( nbnd,nbnd,mat,nbnd,ivpt,info ) + CALL errore('c_phase_field','error in zgetrf', ABS(info)) det=(1.d0,0.d0) - do nb=1,nbnd - if(nb.ne.ivpt(nb)) det=-det + DO nb=1,nbnd + IF (nb /= ivpt(nb)) det = -det det = det*mat(nb,nb) - enddo -! --- Multiply by the already calculated determinants --- + ENDDO + ! --- Multiply by the already calculated determinants --- zeta=zeta*det zeta_loc=zeta_loc*det - -! --- End of dot products between wavefunctions and betas --- + ! + ! --- End of dot products between wavefunctions and betas --- ENDIF - -! --- End loop over parallel k-points --- + ! + ! --- End loop over parallel k-points --- END DO - - if(phase_control==1) then - if(ionode) write(iun_phase,*) kort,is,zeta_loc - else if(phase_control==2) then + ! + IF (phase_control==1) THEN + IF (ionode) write(iun_phase,*) kort,is,zeta_loc + ELSE IF (phase_control==2) THEN zeta_loc=zeta_loc*zetas(kort,is) - endif - + ENDIF + ! zeta_tot=zeta_tot*(zeta_loc**wstring(istring)) -!uncomment the following line for printing string data -! write(stdout,*) 'String :',kort,zeta_loc -! - pola=pola+wstring(istring)*aimag(log(zeta_loc)) - - kpoint=kpoint-1 -! --- Calculate the phase for this string --- - phik(istring)=AIMAG(LOG(zeta)) - cphik(istring)=COS(phik(istring))*(1.0_dp,0.0_dp) & - +SIN(phik(istring))*(0.0_dp,1.0_dp) - -! --- Calculate the localization for current kort --- - zeta_mod= DBLE(CONJG(zeta)*zeta) - loc_k(istring)= - (nppstr_3d(pdir)-1) / gvec**2 / nbnd *log(zeta_mod) - -! --- End loop over orthogonal k-points --- + ! + ! ... uncomment the following line for printing string data + !WRITE (stdout,*) 'String :', kort, zeta_loc + ! + pola = pola + wstring(istring)*AIMAG(LOG(zeta_loc)) + ! + kpoint = kpoint-1 + ! --- Calculate the phase for this string --- + phik(istring) = AIMAG(LOG(zeta)) + cphik(istring) = COS(phik(istring))*(1.0_DP,0.0_DP) & + +SIN(phik(istring))*(0.0_DP,1.0_DP) + ! + ! --- Calculate the localization for current kort --- + zeta_mod = DBLE(CONJG(zeta)*zeta) + loc_k(istring) = -(nppstr_3d(pdir)-1) / gvec**2 / nbnd *LOG(zeta_mod) + + ! --- End loop over orthogonal k-points --- END DO - -! --- End loop over spin --- + ! + ! --- End loop over spin --- END DO -!-----calculate polarization -!-----the factor 2. is because of spin -!new system for avoiding phases problem -! pola=aimag(log(zeta_tot)) - - if(nspin==1) pola=pola*2.d0 - - call factor_a(pdir,at,dkfact) -!factor sqrt(2) is the electronic charge in Rydberg units - pola=pola*dsqrt(2.d0)/tpiba*dkfact - -!write output - write(stdout,*) - write(stdout,*) " Expectation value of exp(iGx):",zeta_tot,dkfact - write(stdout,*) " Electronic Dipole per cell (Ry a.u.)",pola - -! ------------------------------------------------------------------------- ! -! ionic polarization ! -! ------------------------------------------------------------------------- ! - -!factor sqrt(2) is the electronic charge in Rydberg units - pola_ion=0.d0 - DO na=1,nat - pola_ion=pola_ion+zv(ityp(na))*tau(pdir,na)*alat*dsqrt(2.d0) - END DO - - write(stdout,*) " Ionic Dipole per cell (Ry a.u.)",pola_ion - - - el_pola=pola - ion_pola=pola_ion - fact_pola=dsqrt(2.d0)/tpiba*dkfact - - - if(ionode .and. phase_control>0) close(iun_phase) - - -! ------------------------------------------------------------------------- ! - -! --- Free memory --- - DEALLOCATE(l_cal) - DEALLOCATE(pdl_elec) - DEALLOCATE(mod_elec) - DEALLOCATE(wstring) - DEALLOCATE(loc_k) - DEALLOCATE(phik) - DEALLOCATE(cphik) - DEALLOCATE(ln) - DEALLOCATE(map_g) - DEALLOCATE(aux) - DEALLOCATE(aux0) - DEALLOCATE(psi) - DEALLOCATE(psi1) - DEALLOCATE(zetas) - IF (ALLOCATED(aux_2)) DEALLOCATE(aux_2) - IF (ALLOCATED(aux0_2)) DEALLOCATE(aux0_2) - - if(okvan) then - call deallocate_bec_type(becp0) - call deallocate_bec_type(becp_bp) - IF (lspinorb) DEALLOCATE(q_dk_so) - endif - call stop_clock('c_phase_field') - -!------------------------------------------------------------------------------! - + !-----calculate polarization + !-----the factor 2. is because of spin + !new system for avoiding phases problem + !pola=aimag(log(zeta_tot)) + ! + IF (nspin==1) pola=pola*2.d0 + ! + CALL factor_a( pdir, at, dkfact ) + ! + !factor sqrt(2) is the electronic charge in Rydberg units + pola = pola * DSQRT(2.d0) / tpiba * dkfact + ! + !write output + WRITE (stdout,*) + WRITE (stdout,*) " Expectation value of exp(iGx):",zeta_tot,dkfact + WRITE (stdout,*) " Electronic Dipole per cell (Ry a.u.)",pola + ! + ! ------------------------------------------------------------------------- ! + ! ionic polarization ! + ! ------------------------------------------------------------------------- ! + ! + !factor sqrt(2) is the electronic charge in Rydberg units + pola_ion=0.d0 + DO na = 1, nat + pola_ion = pola_ion + zv(ityp(na))*tau(pdir,na)*alat*DSQRT(2.d0) + END DO + ! + WRITE (stdout,*) " Ionic Dipole per cell (Ry a.u.)",pola_ion + ! + ! + el_pola = pola + ion_pola = pola_ion + fact_pola = DSQRT(2.d0)/tpiba*dkfact + ! + IF ( ionode .AND. phase_control>0 ) close(iun_phase) + ! + ! ------------------------------------------------------------------------- ! + ! + ! --- Free memory --- + DEALLOCATE( l_cal ) + DEALLOCATE( pdl_elec ) + DEALLOCATE( mod_elec ) + DEALLOCATE( wstring ) + DEALLOCATE( loc_k ) + DEALLOCATE( phik ) + DEALLOCATE( cphik ) + DEALLOCATE( ln ) + DEALLOCATE( map_g ) + DEALLOCATE( aux ) + DEALLOCATE( aux0 ) + DEALLOCATE( psi ) + DEALLOCATE( psi1 ) + DEALLOCATE( zetas ) + IF (ALLOCATED(aux_2) ) DEALLOCATE( aux_2 ) + IF (ALLOCATED(aux0_2)) DEALLOCATE( aux0_2 ) + ! + IF (okvan) THEN + CALL deallocate_bec_type( becp0 ) + CALL deallocate_bec_type( becp_bp ) + IF (lspinorb) DEALLOCATE( q_dk_so ) + ENDIF + CALL stop_clock( 'c_phase_field' ) + ! + !------------------------------------------------------------------------------! + ! END SUBROUTINE c_phase_field !==============================================================================! diff --git a/PW/src/compute_qdipol.f90 b/PW/src/compute_qdipol.f90 index 9801176af5..4fe4147bf7 100644 --- a/PW/src/compute_qdipol.f90 +++ b/PW/src/compute_qdipol.f90 @@ -5,105 +5,109 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! -SUBROUTINE compute_qdipol(dpqq) +SUBROUTINE compute_qdipol( dpqq ) + !! This routine computes the term dpqq, i.e. the dipole moment of the + !! augmentation charge. The output is given on cartesian coordinates. ! - ! This routine computes the term dpqq, i.e. the dipole moment of the - ! augmentation charge. The output is given on cartesian coordinates + USE kinds, ONLY: DP + USE constants, ONLY: fpi + USE atom, ONLY: rgrid + USE ions_base, ONLY: ntyp => nsp + USE uspp, ONLY: nhtol, nhtolm, indv, nlx, ap + USE uspp_param, ONLY: upf, nbetam, nh, nhm ! - USE kinds, only: DP - USE constants, ONLY: fpi - USE atom, ONLY: rgrid - USE ions_base, ONLY: ntyp => nsp - USE uspp, only: nhtol, nhtolm, indv, nlx, ap - USE uspp_param, only: upf, nbetam, nh, nhm - - implicit none - - REAL(DP) :: dpqq( nhm, nhm, 3, ntyp) - real(DP), allocatable :: qrad2(:,:,:), qtot(:,:,:), aux(:) - real(DP) :: fact - integer :: nt, l, ir, nb, mb, ijv, ilast, ipol, ih, ivl, jh, jvl, lp, ndm - - call start_clock('cmpt_qdipol') - ndm = MAXVAL ( upf(1:ntyp)%kkbeta ) - allocate (qrad2( nbetam , nbetam, ntyp)) - allocate (aux( ndm)) - allocate (qtot( ndm, nbetam, nbetam)) + IMPLICIT NONE + ! + REAL(DP) :: dpqq(nhm, nhm, 3, ntyp) + !! Dipole moment of augmentation charge + REAL(DP), ALLOCATABLE :: qrad2(:,:,:), qtot(:,:,:), aux(:) + REAL(DP) :: fact + INTEGER :: nt, l, ir, nb, mb, ijv, ilast, ipol, ih, ivl, jh, jvl, lp, ndm + ! + CALL start_clock( 'cmpt_qdipol' ) + ! + ndm = MAXVAL( upf(1:ntyp)%kkbeta ) + ALLOCATE( qrad2( nbetam , nbetam, ntyp) ) + ALLOCATE( aux( ndm) ) + ALLOCATE( qtot( ndm, nbetam, nbetam) ) qrad2(:,:,:)=0.d0 dpqq=0.d0 - do nt = 1, ntyp - if ( upf(nt)%tvanp ) then + DO nt = 1, ntyp + IF ( upf(nt)%tvanp ) THEN l=1 -! -! Only l=1 terms enter in the dipole of Q -! - do nb = 1, upf(nt)%nbeta - do mb = nb, upf(nt)%nbeta + ! + ! Only l=1 terms enter in the dipole of Q + ! + DO nb = 1, upf(nt)%nbeta + DO mb = nb, upf(nt)%nbeta ijv = mb * (mb-1) /2 + nb - if ( ( l >= abs(upf(nt)%lll(nb) - upf(nt)%lll(mb)) ) .and. & - ( l <= upf(nt)%lll(nb) + upf(nt)%lll(mb) ) .and. & - (mod (l+upf(nt)%lll(nb)+upf(nt)%lll(mb), 2) == 0) ) then + IF ( ( l >= ABS(upf(nt)%lll(nb) - upf(nt)%lll(mb)) ) .AND. & + ( l <= upf(nt)%lll(nb) + upf(nt)%lll(mb) ) .AND. & + (MOD(l+upf(nt)%lll(nb)+upf(nt)%lll(mb), 2) == 0) ) THEN qtot(1:upf(nt)%kkbeta,nb,mb) = upf(nt)%qfuncl(1:upf(nt)%kkbeta,ijv,l) - endif - enddo - enddo + ENDIF + ENDDO + ENDDO do nb=1, upf(nt)%nbeta ! ! the Q are symmetric with respect to indices ! do mb=nb, upf(nt)%nbeta - if ( ( l >= abs(upf(nt)%lll(nb) - upf(nt)%lll(mb)) ) .and. & - ( l <= upf(nt)%lll(nb) + upf(nt)%lll(mb) ) .and. & - (mod (l+upf(nt)%lll(nb)+upf(nt)%lll(mb), 2) == 0) ) then + if ( ( l >= ABS(upf(nt)%lll(nb) - upf(nt)%lll(mb)) ) .AND. & + ( l <= upf(nt)%lll(nb) + upf(nt)%lll(mb) ) .AND. & + (MOD(l+upf(nt)%lll(nb)+upf(nt)%lll(mb), 2) == 0) ) THEN do ir = 1, upf(nt)%kkbeta aux(ir)=rgrid(nt)%r(ir)*qtot(ir, nb, mb) - enddo + ENDDO call simpson ( upf(nt)%kkbeta, aux, rgrid(nt)%rab, & qrad2(nb,mb,nt) ) - endif - enddo - enddo - endif + ENDIF + ENDDO + ENDDO + ENDIF ! ntyp - enddo + ENDDO - do ipol = 1,3 - fact=-sqrt(fpi/3.d0) - if (ipol.eq.1) lp=3 - if (ipol.eq.2) lp=4 - if (ipol.eq.3) then + DO ipol = 1, 3 + fact = -SQRT(fpi/3.d0) + IF (ipol == 1) lp=3 + IF (ipol == 2) lp=4 + IF (ipol == 3) THEN lp=2 fact=-fact - endif - do nt = 1,ntyp - if ( upf(nt)%tvanp ) then - do ih = 1, nh(nt) + ENDIF + DO nt = 1, ntyp + IF ( upf(nt)%tvanp ) THEN + DO ih = 1, nh(nt) ivl = nhtolm(ih, nt) mb = indv(ih, nt) - do jh = ih, nh (nt) + DO jh = ih, nh(nt) jvl = nhtolm(jh, nt) - nb=indv(jh,nt) - if (ivl > nlx) call errore('compute_qdipol',' ivl > nlx', ivl) - if (jvl > nlx) call errore('compute_qdipol',' jvl > nlx', jvl) - if (nb > nbetam) & - call errore('compute_qdipol',' nb out of bounds', nb) - if (mb > nbetam) & - call errore('compute_qdipol',' mb out of bounds', mb) - if (mb > nb) call errore('compute_qdipol',' mb > nb', 1) - dpqq(ih,jh,ipol,nt)=fact*ap(lp,ivl,jvl)*qrad2(mb,nb,nt) - dpqq(jh,ih,ipol,nt)=dpqq(ih,jh,ipol,nt) + nb = indv(jh,nt) + IF (ivl > nlx) CALL errore( 'compute_qdipol',' ivl > nlx', ivl ) + IF (jvl > nlx) CALL errore( 'compute_qdipol',' jvl > nlx', jvl ) + IF (nb > nbetam) & + CALL errore( 'compute_qdipol',' nb out of bounds', nb ) + IF (mb > nbetam) & + CALL errore( 'compute_qdipol',' mb out of bounds', mb ) + IF (mb > nb) CALL errore( 'compute_qdipol',' mb > nb', 1 ) + dpqq(ih,jh,ipol,nt) = fact * ap(lp,ivl,jvl) * qrad2(mb,nb,nt) + dpqq(jh,ih,ipol,nt) = dpqq(ih,jh,ipol,nt) ! WRITE( stdout,'(3i5,2f15.9)') ih,jh,ipol,dpqq(ih,jh,ipol,nt) - enddo - enddo - endif - enddo - enddo - deallocate(qtot) - deallocate(aux) - deallocate(qrad2) - call stop_clock('cmpt_qdipol') - - return -end subroutine compute_qdipol + ENDDO + ENDDO + ENDIF + ENDDO + ENDDO + ! + DEALLOCATE( qtot ) + DEALLOCATE( aux ) + DEALLOCATE( qrad2 ) + ! + CALL stop_clock( 'cmpt_qdipol' ) + ! + RETURN + ! +END SUBROUTINE compute_qdipol diff --git a/PW/src/compute_qdipol_so.f90 b/PW/src/compute_qdipol_so.f90 index 465e1c6a8f..47387f4d10 100644 --- a/PW/src/compute_qdipol_so.f90 +++ b/PW/src/compute_qdipol_so.f90 @@ -8,11 +8,10 @@ ! ! !---------------------------------------------------------------------- -SUBROUTINE compute_qdipol_so(dpqq,dpqq_so) +SUBROUTINE compute_qdipol_so( dpqq, dpqq_so ) !---------------------------------------------------------------------- - ! - ! This routine multiplies the dpqq coefficients for the - ! spin orbit fcoef coefficients + !! This routine multiplies the dpqq coefficients for the + !! spin orbit fcoef coefficients. ! USE kinds, ONLY : DP USE ions_base, ONLY : ntyp => nsp @@ -21,54 +20,62 @@ SUBROUTINE compute_qdipol_so(dpqq,dpqq_so) USE spin_orb, ONLY : lspinorb, fcoef ! IMPLICIT NONE - REAL(DP) :: dpqq( nhm, nhm, 3, ntyp) - COMPLEX(DP) :: dpqq_so( nhm, nhm, nspin, 3, ntyp) - INTEGER :: ipol ! - ! here a few local variables + REAL(DP) :: dpqq(nhm,nhm,3,ntyp) + !! dpqq coefficients + COMPLEX(DP) :: dpqq_so(nhm,nhm,nspin,3,ntyp) + !! spin orbit fcoef coefficients ! - + ! ... local variables + ! + INTEGER :: ipol INTEGER :: nt, ih, jh, kh, lh, ijs, is1, is2, is - - dpqq_so=(0.d0,0.d0) - DO ipol=1,3 + ! + dpqq_so = (0.d0,0.d0) + ! + DO ipol = 1, 3 DO nt = 1, ntyp + ! IF ( upf(nt)%tvanp ) THEN IF (upf(nt)%has_so) THEN - DO ih=1,nh(nt) - DO jh=1,nh(nt) - DO kh=1,nh(nt) - DO lh=1,nh(nt) - ijs=0 - DO is1=1,2 - DO is2=1,2 - ijs=ijs+1 - DO is=1,2 + DO ih = 1, nh(nt) + DO jh = 1, nh(nt) + DO kh = 1, nh(nt) + DO lh = 1, nh(nt) + ijs = 0 + ! + DO is1 = 1, 2 + DO is2 = 1, 2 + ijs = ijs+1 + DO is = 1, 2 dpqq_so(kh,lh,ijs,ipol,nt)=dpqq_so(kh,lh,ijs,ipol,nt)& +dpqq(ih,jh,ipol,nt)*fcoef(kh,ih,is1,is,nt) & *fcoef(jh,lh,is,is2,nt) - END DO - END DO - END DO - END DO - END DO - END DO - END DO + ENDDO + ENDDO + ENDDO + ! + ENDDO + ENDDO + ENDDO + ENDDO ELSE DO ih = 1, nh (nt) DO jh = ih, nh (nt) IF (lspinorb) THEN - dpqq_so (ih, jh, 1, ipol, nt) = dpqq( ih, jh, ipol, nt) - dpqq_so (jh, ih, 1, ipol, nt) = dpqq_so (ih, jh, 1, ipol, nt) - dpqq_so (ih, jh, 4, ipol, nt) = dpqq_so (ih, jh, 1, ipol, nt) - dpqq_so (jh, ih, 4, ipol, nt) = dpqq_so (ih, jh, 4, ipol, nt) - END IF - END DO - END DO - END IF - END IF - END DO - END DO - + dpqq_so(ih,jh,1,ipol,nt) = dpqq(ih,jh,ipol,nt) + dpqq_so(jh,ih,1,ipol,nt) = dpqq_so(ih,jh,1,ipol,nt) + dpqq_so(ih,jh,4,ipol,nt) = dpqq_so(ih,jh,1,ipol,nt) + dpqq_so(jh,ih,4,ipol,nt) = dpqq_so(ih,jh,4,ipol,nt) + ENDIF + ENDDO + ENDDO + ENDIF + ENDIF + ! + ENDDO + ENDDO + ! RETURN + ! END SUBROUTINE compute_qdipol_so diff --git a/PW/src/compute_ux.f90 b/PW/src/compute_ux.f90 index 2a67792e40..4b04b5b8f7 100644 --- a/PW/src/compute_ux.f90 +++ b/PW/src/compute_ux.f90 @@ -5,33 +5,38 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! - SUBROUTINE compute_ux(m_loc,ux,nat) -! -! This subroutine determines the direction of a fixed quantization axis -! from the starting magnetization. -! - USE kinds, ONLY : dp - USE constants, ONLY: pi, eps12 - USE io_global, ONLY : stdout + SUBROUTINE compute_ux( m_loc,ux,nat ) + ! + !! This subroutine determines the direction of a fixed quantization axis + !! from the starting magnetization. + ! + USE kinds, ONLY : DP + USE constants, ONLY : pi, eps12 + USE io_global, ONLY : stdout USE noncollin_module, ONLY : lsign - + ! IMPLICIT NONE - - INTEGER, INTENT(IN) :: nat ! number of atoms - REAL(DP), INTENT(OUT) :: ux(3) ! fixed direction to calculate signs - REAL(DP), INTENT(IN) :: m_loc(3,nat) ! local moments - + ! + INTEGER, INTENT(IN) :: nat + !! number of atoms + REAL(DP), INTENT(OUT) :: ux(3) + !! fixed direction to calculate signs + REAL(DP), INTENT(IN) :: m_loc(3,nat) + !! local moments + ! + ! ... local variables + ! REAL(DP) :: amag, uxmod ! modulus of the magnetization and of ux - + ! INTEGER :: na ! counter on atoms INTEGER :: starting_na ! auxiliary variable LOGICAL :: is_parallel ! external function true if two vectors are parallel -! -! Do not use the sign feature in the general case -! + ! + ! Do not use the sign feature in the general case + ! lsign=.FALSE. ux=0.0_DP - + ! starting_na=0 DO na=1,nat amag=m_loc(1,na)**2+m_loc(2,na)**2+m_loc(3,na)**2 @@ -43,20 +48,22 @@ SUBROUTINE compute_ux(m_loc,ux,nat) ENDIF ENDDO 20 CONTINUE -! -! The sign feature is used only when all initial magnetizations are parallel -! to a fixed direction that is taken as the quantization axis. -! + ! + ! The sign feature is used only when all initial magnetizations are parallel + ! to a fixed direction that is taken as the quantization axis. + ! DO na=starting_na+1, nat lsign=lsign.AND.is_parallel(ux,m_loc(:,na)) ENDDO - + ! IF (lsign) THEN uxmod=ux(1)**2+ux(2)**2+ux(3)**2 - IF (uxmod 0 term ! !$omp parallel private(aux, gx, rhocg1) ! - allocate (aux( mesh)) + ALLOCATE( aux(mesh) ) !$omp do - do igl = igl0, ngl - gx = sqrt (gl (igl) * tpiba2) - do ir = 1, mesh - aux (ir) = r (ir) * rhoc (ir) * (r (ir) * cos (gx * r (ir) ) & - / gx - sin (gx * r (ir) ) / gx**2) - enddo - call simpson (mesh, aux, rab, rhocg1) - drhocg (igl) = fpi / omega * rhocg1 - enddo + DO igl = igl0, ngl + gx = SQRT( gl(igl) * tpiba2 ) + DO ir = 1, mesh + aux(ir) = r(ir)*rhoc(ir)*( r(ir) * COS(gx*r(ir)) / & + gx - SIN(gx*r(ir)) / gx**2 ) + ENDDO + CALL simpson( mesh, aux, rab, rhocg1 ) + drhocg(igl) = fpi / omega * rhocg1 + ENDDO !$omp end do nowait - deallocate (aux) + DEALLOCATE( aux ) + ! !$omp end parallel - - return -end subroutine deriv_drhoc + ! + RETURN + ! +END SUBROUTINE deriv_drhoc diff --git a/PW/src/divide_class.f90 b/PW/src/divide_class.f90 index 9b1d3c5ca2..e5fe3c9db4 100644 --- a/PW/src/divide_class.f90 +++ b/PW/src/divide_class.f90 @@ -7,43 +7,53 @@ ! ! !----------------------------------------------------------------------------- -SUBROUTINE divide_class(code_group,nrot,smat,nclass,nelem,elem,which_irr) +SUBROUTINE divide_class( code_group, nrot, smat, nclass, nelem, elem, which_irr ) !----------------------------------------------------------------------------- +!! This subroutine receives as input a set of nrot 3x3 matrices smat, which +!! are assumed to be the operations of the point group given by code_group. +!! smat are in cartesian coordinates. This routine divides the group in +!! classes and find: + +!! * nclass: the number of classes of the group +!! * nelem(iclass): for each class, the number of elements of the class +!! * elem(i,iclass): 1 < i < nelem(iclass) for each class tells which matrices +!! smat belong to that class +!! * which_irr(iclass): for each class gives the position of that class in the +!! character table associated with the group and provided +!! by the routine set_irr_rap. + +!! NB: changing the order of +!! the elements in the character table must be reflected in +!! a change to which_irr. Presently the character tables +!! are those given by P.W. Atkins, M.S. Child, and +!! C.S.G. Phillips, "Tables for group theory". +!! Several equivalent names for the irreducible representation +!! are given. D, G, L, S are used for Delta, Gamma, Lambda +!! and Sigma. ! -! This subroutine receives as input a set of nrot 3x3 matrices smat, which -! are assumed to be the operations of the point group given by code_group. -! smat are in cartesian coordinates. -! This routine divides the group in classes and find: -! -! nclass the number of classes of the group -! nelem(iclass) for each class, the number of elements of the class -! elem(i,iclass) 1=0. In the xy plane the axis is in the x>0 region and the positive -! y axis is taken for z=0 and x=0. +!! This subroutine receives a rotation matrix and determines the rotation +!! axis. The orientation of the axis is with the tip in the hemisphere +!! z>=0. In the xy plane the axis is in the x>0 region and the positive +!! y axis is taken for z=0 and x=0. ! USE kinds, ONLY : DP +! IMPLICIT NONE - -REAL(DP) :: smat(3,3), ax(3) +! +REAL(DP) :: smat(3,3) +!! the rotation matrix +REAL(DP) :: ax(3) +!! the rotation axis REAL(DP), PARAMETER :: eps=1.d-7 REAL(DP) :: a1(3), norm INTEGER :: ipol, jpol, tipo_sym, ts @@ -956,25 +974,25 @@ SUBROUTINE versor(smat,ax) ! Check if it is a 180 rotation ! ts=tipo_sym(smat) -IF (ts/=3.and.ts/=4.and.ts/=6) & - call errore('versor','called in the wrong case',1) +IF (ts/=3.AND.ts/=4.AND.ts/=6) & + CALL errore('versor','called in the wrong case',1) IF (ts==4) THEN -! -! First the case where the axis is parallel to a coordinate axis -! + ! + ! First the case where the axis is parallel to a coordinate axis + ! ax=0.d0 DO ipol=1,3 IF (ABS(smat(ipol,ipol)-1.d0) < eps ) ax(ipol)=1.d0 END DO - norm=sqrt(ax(1)**2+ax(2)**2+ax(3)**2) + norm=SQRT(ax(1)**2+ax(2)**2+ax(3)**2) IF (ABS(norm)>eps) RETURN -! -! then the general case -! + ! + ! then the general case + ! DO ipol=1,3 - a1(ipol)=sqrt(ABS(smat(ipol,ipol)+1.d0)/2.d0) + a1(ipol)=SQRT(ABS(smat(ipol,ipol)+1.d0)/2.d0) END DO - + ! DO ipol=1,3 DO jpol=ipol+1,3 IF (ABS(a1(ipol)*a1(jpol))>eps) THEN @@ -982,15 +1000,15 @@ SUBROUTINE versor(smat,ax) END IF END DO END DO - + ! ELSE -! -! It is not a 180 rotation: compute the rotation axis -! - a1(1) =-smat(2,3)+smat(3,2) - a1(2) =-smat(3,1)+smat(1,3) - a1(3) =-smat(1,2)+smat(2,1) - + ! + ! It is not a 180 rotation: compute the rotation axis + ! + a1(1) = -smat(2,3)+smat(3,2) + a1(2) = -smat(3,1)+smat(1,3) + a1(3) = -smat(1,2)+smat(2,1) + ! END IF ! ! The direction of the axis is arbitrarily chosen, with positive z. In the @@ -998,57 +1016,58 @@ SUBROUTINE versor(smat,ax) ! IF (a1(3) < -eps ) THEN a1=-a1 -ELSEIF (abs(a1(3)) 1.0_DP+eps) CALL errore('angle_rot','problem with sint',1) +sint=0.5d0*SQRT(a1(1)**2+a1(2)**2+a1(3)**2) +IF (sint 1.0_DP+eps) CALL errore( 'angle_rot','problem with sint', 1 ) ! ! small rounding errors that make |sint|>1.0 produce NaN in the next ASIN ! function, so we remove them @@ -1080,13 +1099,13 @@ FUNCTION angle_rot(smat) ax=a1 IF (ax(3) < -eps ) THEN ax=-ax -ELSEIF (abs(ax(3))eps) THEN - sint=SIGN(sint,a1(1)/ax(1)) + sint=SIGN( sint, a1(1)/ax(1) ) ELSEIF (ABS(a1(2))>eps) THEN sint=SIGN(sint,a1(2)/ax(2)) ELSEIF (ABS(a1(3))>eps) THEN @@ -1103,7 +1122,7 @@ FUNCTION angle_rot(smat) ELSE IF (ABS(ax(3)**2-1.d0)>eps) THEN cost=(smat(3,3)-ax(3)**2)/(1.d0-ax(3)**2) END IF - +! IF (ABS(sint**2+cost**2-1.d0) > eps ) & CALL errore('angle_rot','problem with the matrix',1) angle_rot1=ASIN(sint)*180.d0/pi @@ -1116,160 +1135,164 @@ FUNCTION angle_rot(smat) ELSE IF (cost < 0.d0) angle_rot1=-angle_rot1+180.d0 ENDIF - +! angle_rot=angle_rot1 - +! RETURN +! END FUNCTION angle_rot !----------------------------------------------------------------------------- -FUNCTION angle_rot_s(smat) +FUNCTION angle_rot_s( smat ) !----------------------------------------------------------------------------- -! -! This subroutine receives an improper rotation matrix and determines the -! rotation angle. +!! This subroutine receives an improper rotation matrix and determines the +!! rotation angle. ! USE kinds, ONLY : DP +! IMPLICIT NONE - +! REAL(DP) :: smat(3,3) - +! REAL(DP) :: aux_mat(3,3) REAL(DP) :: angle_rot, angle_rot_s - +! aux_mat=-smat -angle_rot_s=mod(angle_rot(aux_mat)+180.0_DP,360.0_DP) - +angle_rot_s=MOD(angle_rot(aux_mat)+180.0_DP,360.0_DP) +! RETURN - +! END FUNCTION angle_rot_s - - +! !----------------------------------------------------------------------------- -SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & - name_class,ir_ram) +SUBROUTINE set_irr_rap( code_group, nclass_ref, char_mat, name_rap, & + name_class, ir_ram ) !----------------------------------------------------------------------------- -! -! This subroutine collects the character tables of the 32 crystallographic -! point groups. -! Various names have been used in the litterature to identify -! the irreducible representations. Several equivalent names are -! collected in this routine. The first name is taken -! from the book of P.W. Atkins, M.S. Child, and C.S.G. Phillips, -! "Tables for group theory". -! D, G, L, S are used for Delta, Gamma, Lambda and Sigma. -! Representations which correspond to infrared or raman active modes -! are identified with the string in ir_ram: I (infrared active), -! R (Raman active), I+R (Infrared and Raman active). -! +!! This subroutine collects the character tables of the 32 crystallographic +!! point groups. + +!! Various names have been used in the litterature to identify +!! the irreducible representations. Several equivalent names are +!! collected in this routine. The first name is taken +!! from the book of P.W. Atkins, M.S. Child, and C.S.G. Phillips, +!! "Tables for group theory". +!! D, G, L, S are used for Delta, Gamma, Lambda and Sigma. +!! Representations which correspond to infrared or raman active modes +!! are identified with the string in ir_ram: I (infrared active), +!! R (Raman active), I+R (Infrared and Raman active). ! USE kinds, ONLY : DP +! IMPLICIT NONE - -INTEGER :: nclass_ref, & ! Output: number of irreducible representation - code_group ! Input: code of the group - -CHARACTER(LEN=15) :: name_rap(12) ! Output: name of the representations -CHARACTER(LEN=5) :: name_class(12) ! Output: name of the classes +! +INTEGER :: nclass_ref +!! Output: number of irreducible representation +INTEGER :: code_group +!! Input: code of the group +CHARACTER(LEN=15) :: name_rap(12) +!! Output: name of the representations +CHARACTER(LEN=5) :: name_class(12) +!! Output: name of the classes CHARACTER(LEN=3) :: ir_ram(12) - -COMPLEX(DP) :: char_mat(12,12) ! Output: character matrix - +!! Representation labels +COMPLEX(DP) :: char_mat(12,12) +!! Output: character matrix +! REAL(DP) :: sqr3d2 - +! sqr3d2=SQRT(3.d0)*0.5d0 -char_mat=(1.d0,0.d0) + char_mat=(1.d0,0.d0) name_class(1)="E " ir_ram=" " IF (code_group==1) THEN -! -! C_1 -! + ! + ! C_1 + ! nclass_ref=1 - + ! name_rap(1)="A " ir_ram(1)="I+R" - + ! ELSEIF (code_group==2) THEN -! -! C_i -! + ! + ! C_i + ! nclass_ref=2 name_class(2)="i " - + ! name_rap(1)="A_g " ir_ram(1)="R" - + ! name_rap(2)="A_u " ir_ram(2)="I" char_mat(2,2)=(-1.d0,0.d0) - + ! ELSEIF (code_group==3) THEN -! -! C_s -! + ! + ! C_s + ! nclass_ref=2 name_class(2)="s " - + ! name_rap(1)="A' " ir_ram(1)="I+R" - + ! name_rap(2)="A'' " ir_ram(2)="I+R" char_mat(2,2)=(-1.d0,0.d0) - + ! ELSEIF (code_group==4) THEN -! -! C_2 -! + ! + ! C_2 + ! nclass_ref=2 name_class(2)="C2 " - + ! name_rap(1)="A " ir_ram(1)="I+R" - + ! name_rap(2)="B " ir_ram(2)="I+R" char_mat(2,2)=(-1.d0,0.d0) - + ! ELSEIF (code_group==5) THEN -! -! C_3 -! + ! + ! C_3 + ! nclass_ref=3 name_class(2)="C3 " name_class(3)="C3^2 " - + ! name_rap(1)="A " ir_ram(1)="I+R" - + ! name_rap(2)="E " ir_ram(2)="I+R" char_mat(2,2)=CMPLX(-0.5d0,sqr3d2,kind=DP) char_mat(2,3)=CMPLX(-0.5d0,-sqr3d2,kind=DP) - + ! name_rap(3)="E* " ir_ram(3)="I+R" char_mat(3,2)=CMPLX(-0.5d0,-sqr3d2,kind=DP) char_mat(3,3)=CMPLX(-0.5d0,sqr3d2,kind=DP) - - + ! + ! ELSEIF (code_group==6) THEN -! -! C_4 -! + ! + ! C_4 + ! nclass_ref=4 name_class(2)="C4 " name_class(3)="C2 " name_class(4)="C4^3 " - + ! name_rap(1)="A " ir_ram(1)="I+R" - + ! name_rap(2)="B " ir_ram(2)="R" char_mat(2,2)=(-1.d0,0.d0) @@ -1286,27 +1309,27 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(4,2)=( 0.d0,-1.d0) char_mat(4,3)=(-1.d0,0.d0) char_mat(4,4)=( 0.d0,1.d0) - - + ! + ! ELSEIF (code_group==7) THEN -! -! C_6 -! + ! + ! C_6 + ! nclass_ref=6 name_class(2)="C6 " name_class(3)="C3 " name_class(4)="C2 " name_class(5)="C3^2 " name_class(6)="C6^5 " - + ! name_rap(1)="A " ir_ram(1)="I+R" - + ! name_rap(2)="B " char_mat(2,2)=(-1.d0,0.d0) char_mat(2,4)=(-1.d0,0.d0) char_mat(2,6)=(-1.d0,0.d0) - + ! name_rap(3)="E_1 " ir_ram(3)="I+R" char_mat(3,2)=CMPLX( 0.5d0,sqr3d2,kind=DP) @@ -1314,7 +1337,7 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(3,4)=(-1.d0,0.d0) char_mat(3,5)=CMPLX(-0.5d0,-sqr3d2,kind=DP) char_mat(3,6)=CMPLX( 0.5d0,-sqr3d2,kind=DP) - + ! name_rap(4)="E_1*" ir_ram(4)="I+R" char_mat(4,2)=CMPLX( 0.5d0,-sqr3d2,kind=DP) @@ -1322,63 +1345,63 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(4,4)=(-1.d0,0.d0) char_mat(4,5)=CMPLX(-0.5d0,sqr3d2,kind=DP) char_mat(4,6)=CMPLX( 0.5d0,sqr3d2,kind=DP) - + ! name_rap(5)="E_2 " ir_ram(5)="R" char_mat(5,2)=CMPLX(-0.5d0,sqr3d2,kind=DP) char_mat(5,3)=CMPLX(-0.5d0,-sqr3d2,kind=DP) char_mat(5,5)=CMPLX(-0.5d0,sqr3d2,kind=DP) char_mat(5,6)=CMPLX(-0.5d0,-sqr3d2,kind=DP) - + ! name_rap(6)="E_2*" ir_ram(6)="R" char_mat(6,2)=CMPLX(-0.5d0,-sqr3d2,kind=DP) char_mat(6,3)=CMPLX(-0.5d0,sqr3d2,kind=DP) char_mat(6,5)=CMPLX(-0.5d0,-sqr3d2,kind=DP) char_mat(6,6)=CMPLX(-0.5d0,sqr3d2,kind=DP) - + ! ELSEIF (code_group==8) THEN -! -! D_2 -! + ! + ! D_2 + ! nclass_ref=4 name_class(2)="C2 " name_class(3)="C2' " name_class(4)="C2'' " - + ! name_rap(1)="A " ir_ram(1)="R" - + ! name_rap(2)="B_1 " ir_ram(2)="I+R" char_mat(2,3)=(-1.d0,0.d0) char_mat(2,4)=(-1.d0,0.d0) - + ! name_rap(3)="B_2 " ir_ram(3)="I+R" char_mat(3,2)=(-1.d0,0.d0) char_mat(3,4)=(-1.d0,0.d0) - + ! name_rap(4)="B_3 " ir_ram(4)="I+R" char_mat(4,2)=(-1.d0,0.d0) char_mat(4,3)=(-1.d0,0.d0) - + ! ELSEIF (code_group==9) THEN -! -! D_3 -! + ! + ! D_3 + ! nclass_ref=3 name_class(2)="2C3 " name_class(3)="3C2' " - + ! name_rap(1)="A_1 " ir_ram(1)="R" - + ! name_rap(2)="A_2 " ir_ram(2)="I" char_mat(2,3)=(-1.d0,0.d0) - + ! name_rap(3)="E " ir_ram(3)="I+R" char_mat(3,1)=( 2.d0,0.d0) @@ -1386,28 +1409,28 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(3,3)=( 0.d0,0.d0) ELSEIF (code_group==10) THEN -! -! D_4 -! + ! + ! D_4 + ! nclass_ref=5 name_class(2)="2C4 " name_class(3)="C2 " name_class(4)="2C2' " name_class(5)="2C2''" - + ! name_rap(1)="A_1 " ir_ram(1)="R" - + ! name_rap(2)="A_2 " ir_ram(2)="I" char_mat(2,4)=(-1.d0,0.d0) char_mat(2,5)=(-1.d0,0.d0) - + ! name_rap(3)="B_1 " ir_ram(3)="R" char_mat(3,2)=(-1.d0,0.d0) char_mat(3,5)=(-1.d0,0.d0) - + ! name_rap(4)="B_2 " ir_ram(4)="R" char_mat(4,2)=(-1.d0,0.d0) @@ -1422,9 +1445,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(5,5)=( 0.d0,0.d0) ELSEIF (code_group==11) THEN -! -! D_6 -! + ! + ! D_6 + ! nclass_ref=6 name_class(2)="2C6 " name_class(3)="2C3 " @@ -1468,9 +1491,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(6,6)=( 0.d0,0.d0) ELSEIF (code_group==12) THEN -! -! C_2v -! + ! + ! C_2v + ! nclass_ref=4 name_class(2)="C2 " name_class(3)="s_v " @@ -1495,9 +1518,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(4,3)=(-1.d0,0.d0) ELSEIF (code_group==13) THEN -! -! C_3v -! + ! + ! C_3v + ! nclass_ref=3 name_class(2)="2C3 " name_class(3)="3s_v " @@ -1515,9 +1538,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(3,3)=( 0.d0,0.d0) ELSEIF (code_group==14) THEN -! -! C_4v -! + ! + ! C_4v + ! nclass_ref=5 name_class(2)="2C4 " name_class(3)="C2 " @@ -1550,9 +1573,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(5,5)=( 0.d0,0.d0) ELSEIF (code_group==15) THEN -! -! C_6v -! + ! + ! C_6v + ! nclass_ref=6 name_class(2)="2C6 " name_class(3)="2C3 " @@ -1595,9 +1618,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(6,6)=( 0.d0,0.d0) ELSEIF (code_group==16) THEN -! -! C_2h -! + ! + ! C_2h + ! nclass_ref=4 name_class(2)="C2 " name_class(3)="i " @@ -1622,9 +1645,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(4,3)=(-1.d0,0.d0) ELSEIF (code_group==17) THEN -! -! C_3h -! + ! + ! C_3h + ! nclass_ref=6 name_class(2)="C3 " name_class(3)="C3^2 " @@ -1673,9 +1696,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & ELSEIF (code_group==18) THEN -! -! C_4h -! + ! + ! C_4h + ! nclass_ref=8 name_class(2)="C4 " name_class(3)="C2 " @@ -1745,9 +1768,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(8,8)=( 0.d0,-1.d0) ELSEIF (code_group==19) THEN -! -! C_6h -! + ! + ! C_6h + ! nclass_ref=12 name_class(2)="C6 " name_class(3)="C3 " @@ -1888,9 +1911,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(12,12)=CMPLX( 0.5d0,-sqr3d2,kind=DP) ELSEIF (code_group==20) THEN -! -! D_2h -! + ! + ! D_2h + ! nclass_ref=8 name_class(2)="C2 " name_class(3)="C2' " @@ -1952,9 +1975,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(8,8)=(-1.d0,0.d0) ELSEIF (code_group==21) THEN -! -! D_3h -! + ! + ! D_3h + ! nclass_ref=6 name_class(2)="2C3 " name_class(3)="3C2 " @@ -1998,9 +2021,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(6,6)=( 0.d0,0.d0) ELSEIF (code_group==22) THEN -! -! D_4h -! + ! + ! D_4h + ! nclass_ref=10 name_class(2)="2C4 " name_class(3)="C2 " @@ -2092,9 +2115,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(10,10)=( 0.d0,0.d0) ELSEIF (code_group==23) THEN -! -! D_6h -! + ! + ! D_6h + ! nclass_ref=12 name_class(2)="2C6 " name_class(3)="2C3 " @@ -2220,9 +2243,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(12,12)=( 0.d0,0.d0) ELSEIF (code_group==24) THEN -! -! D_2d -! + ! + ! D_2d + ! nclass_ref=5 name_class(2)="2S4 " name_class(3)="C2 " @@ -2255,9 +2278,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(5,5)=( 0.d0,0.d0) ELSEIF (code_group==25) THEN -! -! D_3d -! + ! + ! D_3d + ! nclass_ref=6 name_class(2)="2C3 " name_class(3)="3C2' " @@ -2301,9 +2324,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(6,6)=( 0.d0,0.d0) ELSEIF (code_group==26) THEN -! -! S_4 -! + ! + ! S_4 + ! nclass_ref=4 name_class(2)="S4^3 " name_class(3)="C2 " @@ -2330,9 +2353,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(4,4)=( 0.d0, 1.d0) ELSEIF (code_group==27) THEN -! -! S_6 -! + ! + ! S_6 + ! nclass_ref=6 name_class(2)="C3 " name_class(3)="C3^2 " @@ -2382,9 +2405,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & ELSEIF (code_group==28) THEN -! -! T -! + ! + ! T + ! nclass_ref=4 name_class(2)="3C2 " name_class(3)="4C3 " @@ -2411,9 +2434,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(4,2)=(-1.0d0,0.d0) ELSEIF (code_group==29) THEN -! -! T_h -! + ! + ! T_h + ! nclass_ref=8 name_class(2)="3C2 " name_class(3)="4C3 " @@ -2485,9 +2508,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & ELSEIF (code_group==30) THEN -! -! T_d -! + ! + ! T_d + ! nclass_ref=5 name_class(2)="8C3 " name_class(3)="3C2 " @@ -2523,9 +2546,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(5,4)=(-1.d0,0.d0) ELSEIF (code_group==31) THEN -! -! O -! + ! + ! O + ! nclass_ref=5 name_class(2)="8C3 " name_class(3)="3C2 " @@ -2562,9 +2585,9 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & char_mat(5,4)=(-1.d0,0.d0) ELSEIF (code_group==32) THEN -! -! O_h -! + ! + ! O_h + ! nclass_ref=10 name_class(2)="8C3 " name_class(3)="3C2 " @@ -2666,124 +2689,148 @@ SUBROUTINE set_irr_rap(code_group,nclass_ref,char_mat,name_rap, & ELSE CALL errore('set_irr_rap','code number not allowed',1) END IF - +! RETURN +! END SUBROUTINE set_irr_rap !-------------------------------------------------------------------------- -FUNCTION is_complex(code) +FUNCTION is_complex( code ) !-------------------------------------------------------------------------- -! This function receives a code of the group and provide .true. or -! .false. if the group HAS or HAS NOT complex irreducible -! representations. -! The order is the following: -! -! 1 "C_1 " F 11 "D_6 " F 21 "D_3h" F 31 "O " F -! 2 "C_i " F 12 "C_2v" F 22 "D_4h" F 32 "O_h " F -! 3 "C_s " F 13 "C_3v" F 23 "D_6h" F -! 4 "C_2 " F 14 "C_4v" F 24 "D_2d" F -! 5 "C_3 " T 15 "C_6v" F 25 "D_3d" F -! 6 "C_4 " T 16 "C_2h" F 26 "S_4 " T -! 7 "C_6 " T 17 "C_3h" T 27 "S_6 " T -! 8 "D_2 " F 18 "C_4h" T 28 "T " T -! 9 "D_3 " F 19 "C_6h" T 29 "T_h " T -! 10 "D_4 " F 20 "D_2h" F 30 "T_d " F +!! This function receives a code of the group and provide .true. or +!! .false. if the group HAS or HAS NOT complex irreducible +!! representations. The order is the following: + +!! 1 "C_1 " F 11 "D_6 " F 21 "D_3h" F 31 "O " F + +!! 2 "C_i " F 12 "C_2v" F 22 "D_4h" F 32 "O_h " F + +!! 3 "C_s " F 13 "C_3v" F 23 "D_6h" F + +!! 4 "C_2 " F 14 "C_4v" F 24 "D_2d" F + +!! 5 "C_3 " T 15 "C_6v" F 25 "D_3d" F + +!! 6 "C_4 " T 16 "C_2h" F 26 "S_4 " T + +!! 7 "C_6 " T 17 "C_3h" T 27 "S_6 " T + +!! 8 "D_2 " F 18 "C_4h" T 28 "T " T + +!! 9 "D_3 " F 19 "C_6h" T 29 "T_h " T + +!! 10 "D_4 " F 20 "D_2h" F 30 "T_d " F ! IMPLICIT NONE - +! INTEGER :: code LOGICAL :: is_complex - +! LOGICAL :: complex_aux(32) - -data complex_aux / .FALSE., .FALSE., .FALSE., .FALSE., .TRUE. , & +! +DATA complex_aux / .FALSE., .FALSE., .FALSE., .FALSE., .TRUE. , & .TRUE. , .TRUE. , .FALSE., .FALSE., .FALSE., & .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., & .FALSE., .TRUE. , .TRUE. , .TRUE. , .FALSE., & .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., & .TRUE. , .TRUE. , .TRUE. , .TRUE. , .FALSE., & .FALSE., .FALSE. / - +! IF (code < 1 .OR. code > 32 ) CALL errore('is_complex', & 'code is out of range',1) - +! is_complex= complex_aux(code) - +! RETURN +! END FUNCTION is_complex + FUNCTION is_parallel(a,b) -! -! This function returns true if a(3) and b(3) are parallel vectors +!! This function returns true if a(3) and b(3) are parallel vectors ! USE kinds, ONLY : DP -IMPLICIT none +! +IMPLICIT NONE +! LOGICAL :: is_parallel REAL(DP) :: a(3), b(3) REAL(DP) :: cross - -cross=(a(2)*b(3)-a(3)*b(2))**2+(a(3)*b(1)-a(1)*b(3))**2+(a(1)*b(2)-a(2)*b(1))**2 - +! + cross=(a(2)*b(3)-a(3)*b(2))**2+(a(3)*b(1)-a(1)*b(3))**2+(a(1)*b(2)-a(2)*b(1))**2 +! is_parallel=(ABS(cross)< 1.d-6) - +! RETURN +! END FUNCTION is_parallel -FUNCTION angle_vectors(ax,bx) -! -! This function returns the angle, in degrees between two vectors + +FUNCTION angle_vectors( ax, bx ) +!! This function returns the angle, in degrees between two vectors ! USE kinds, ONLY : DP USE constants, ONLY : pi -IMPLICIT none +! +IMPLICIT NONE +! REAL(DP) :: angle_vectors REAL(DP) :: ax(3), bx(3) REAL(DP) :: cosangle, moda, modb - -moda=sqrt(ax(1)**2+ax(2)**2+ax(3)**2) -modb=sqrt(bx(1)**2+bx(2)**2+bx(3)**2) - +! +moda=SQRT( ax(1)**2+ax(2)**2+ax(3)**2 ) +modb=SQRT( bx(1)**2+bx(2)**2+bx(3)**2 ) +! IF (moda<1.d-12.OR.modb<1.d-12) & CALL errore('angle vectors','zero module vector',1) -cosangle = (ax(1)*bx(1)+ax(2)*bx(2)+ax(3)*bx(3))/moda/modb -angle_vectors = acos(cosangle) * 180.d0 / pi - + cosangle = (ax(1)*bx(1)+ax(2)*bx(2)+ax(3)*bx(3))/moda/modb +angle_vectors = ACOS(cosangle) * 180.d0 / pi +! RETURN +! END FUNCTION angle_vectors -SUBROUTINE set_class_el_name(nsym,sname,nclass,nelem,elem,elem_name) +SUBROUTINE set_class_el_name( nsym, sname, nclass, nelem, elem, elem_name ) +! IMPLICIT NONE +! INTEGER :: nsym CHARACTER(LEN=45) :: sname(nsym) CHARACTER(LEN=55) :: elem_name(8,12) INTEGER :: nclass, nelem(12), elem(8,12) - +! INTEGER :: iclass, ielem - +! DO iclass=1,nclass DO ielem=1,nelem(iclass) elem_name(ielem,iclass)=sname(elem(ielem,iclass)) ENDDO ENDDO - +! RETURN +! END SUBROUTINE set_class_el_name -SUBROUTINE which_c2( a, ia) -! -! This routine gives a code to identify the direction of a C_2 axis -! x 1 y=z, x=0 4 x=-z, y=0 7 y= m x, z=0 10 y=-x/m, z=0 13 -! y 2 y=-z, x=0 5 y=x, z=0 8 y= -m x, z=0 11 -! z 3 x=z, y=0 6 y=-x, z=0 9 y= x/m, z=0 12 -! -! m=sqrt(3.) + +SUBROUTINE which_c2( a, ia ) +!! This routine gives a code to identify the direction of a C_2 axis + +!! x 1 y=z, x=0 4 x=-z, y=0 7 y= m x, z=0 10 y=-x/m, z=0 13 + +!! y 2 y=-z, x=0 5 y=x, z=0 8 y= -m x, z=0 11 + +!! z 3 x=z, y=0 6 y=-x, z=0 9 y= x/m, z=0 12 + +!! m=sqrt(3.) ! USE kinds, ONLY : DP +! IMPLICIT NONE -REAL(DP), INTENT(IN) :: a(3) -INTEGER, INTENT(OUT) :: ia +! +REAL(DP), INTENT(IN) :: a(3) +INTEGER, INTENT(OUT) :: ia REAL(DP) :: epsil=1.D-7, sqr3=SQRT(3.0_DP) LOGICAL :: is_axis @@ -2829,28 +2876,31 @@ SUBROUTINE which_c2( a, ia) ELSE CALL errore('which_c2','c2 axis not recognized',4) ENDIF - +! RETURN +! END SUBROUTINE which_c2 -SUBROUTINE is_c2v(iax,ibx,icx,isok) -! -! This subroutine receives the indeces of a C_2 axis iax, with the convention -! of the routine which_c2, and of the perpendicular of two mirrors, ibx and -! icx with the same convention. It returns .true. in isok if the combination -! corresponds to a known possibility for C_2v. Usually isok .FALSE. means -! that the two mirrors are not in the correct order. -! -! Note: the order of the two mirrors in C_2v is defined by the -! condition to have the same double group multiplication table of the -! isomorphous group D_2. Only the order of one D_2 is arbitrary, -! all the C_2v and D_2 are ordered for isomorphism of the double -! groups + +SUBROUTINE is_c2v( iax, ibx, icx, isok ) +!------------------------------------------------------------------------------ +!! This subroutine receives the indeces of a C_2 axis iax, with the convention +!! of the routine which_c2, and of the perpendicular of two mirrors, ibx and +!! icx with the same convention. It returns .true. in isok if the combination +!! corresponds to a known possibility for C_2v. Usually isok .FALSE. means +!! that the two mirrors are not in the correct order. + +!! Note: the order of the two mirrors in C_2v is defined by the +!! condition to have the same double group multiplication table of the +!! isomorphous group D_2. Only the order of one D_2 is arbitrary, +!! all the C_2v and D_2 are ordered for isomorphism of the double +!! groups ! IMPLICIT NONE +! INTEGER, INTENT(IN) :: iax, ibx, icx LOGICAL, INTENT(OUT) :: isok - +! isok=.FALSE. isok = isok .OR. ( iax==1 .AND. ibx==2 .AND. icx==3 ) isok = isok .OR. ( iax==1 .AND. ibx==4 .AND. icx==5 ) @@ -2870,28 +2920,30 @@ SUBROUTINE is_c2v(iax,ibx,icx,isok) isok = isok .OR. ( iax==13.AND. ibx==10.AND. icx==3 ) isok = isok .OR. ( iax==10.AND. ibx==3 .AND. icx==13 ) isok = isok .OR. ( iax==11.AND. ibx==12 .AND. icx==3 ) - +! RETURN +! END SUBROUTINE is_c2v -SUBROUTINE is_d2(iax, ibx, icx, ind2) -! -! This routine receives as input the indices of three c2 axes, with the -! same codes as in which_c2, and gives as output the array ind2(3) of intergers, -! that gives the positions of iax, ibx, icx in the list C_2, C_2', C_2'' -! ind2(1) says which is the position of iax, ecc. -! For instance ind2 = 3, 2, 1 says that iax is C_2'', ibx is C_2' and icx is -! C_2. If on output ind2 = 0, 0, 0 means that iax, ibx, and icx does not belong -! to a possible D_2 -! -! Note: this order is arbitrary for one D_2, all the others should be -! isomorphous with the same double group multiplication table. -! +SUBROUTINE is_d2( iax, ibx, icx, ind2 ) +!------------------------------------------------------------------------------ +!! This routine receives as input the indices of three c2 axes, with the +!! same codes as in which_c2, and gives as output the array ind2(3) of intergers, +!! that gives the positions of iax, ibx, icx in the list C_2, C_2', C_2'' +!! ind2(1) says which is the position of iax, ecc. +!! For instance ind2 = 3, 2, 1 says that iax is C_2'', ibx is C_2' and icx is +!! C_2. If on output ind2 = 0, 0, 0 means that iax, ibx, and icx does not belong +!! to a possible D_2 + +!! Note: this order is arbitrary for one D_2, all the others should be +!! isomorphous with the same double group multiplication table. +! IMPLICIT NONE +! INTEGER, INTENT(IN) :: iax, ibx, icx INTEGER, INTENT(OUT) :: ind2(3) - +! ind2=0 IF (iax==1) THEN IF (ibx==2) THEN @@ -3068,7 +3120,8 @@ SUBROUTINE is_d2(iax, ibx, icx, ind2) ELSE CALL errore('is_d2','D_2 problem with C_2 axis',9) END IF - + ! RETURN +! END SUBROUTINE is_d2 From 69f31ecffc45a0d4e7568ebf135480288a42cbac Mon Sep 17 00:00:00 2001 From: Pietro Delugas Date: Fri, 28 Jun 2019 11:26:22 +0000 Subject: [PATCH 35/95] fix ph.x in case qplot=.true. for gamma at iq/=1 when a ph.x calculation for q=Gamma and this is not the first computed q nscf calculation must be run. The temporary directories must treated as for the other points in this case. --- PHonon/PH/check_initial_status.f90 | 6 +++++- PHonon/PH/prepare_q.f90 | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/PHonon/PH/check_initial_status.f90 b/PHonon/PH/check_initial_status.f90 index 0ceeb120ae..b60910e4b0 100644 --- a/PHonon/PH/check_initial_status.f90 +++ b/PHonon/PH/check_initial_status.f90 @@ -306,10 +306,14 @@ SUBROUTINE check_initial_status(auxdyn) ! ... each q /= gamma works on a different directory. We create them ! here and copy the charge density inside ! - IF ((.NOT.lgamma.OR. newgrid).AND.lqdir) THEN + IF ((.NOT.lgamma.OR. newgrid .OR. (qplot .AND. iq /=1)) .AND.lqdir) THEN tmp_dir_phq= trimcheck ( TRIM (tmp_dir_ph) // TRIM(prefix) // & & '.q_' // int_to_char(iq) ) +#if defined(__HDF5) + filename=TRIM(tmp_dir_phq)//TRIM(prefix)//postfix//'charge-density.hdf5' +#else filename=TRIM(tmp_dir_phq)//TRIM(prefix)//postfix//'charge-density.dat' +#endif IF (ionode) inquire (file =TRIM(filename), exist = exst) ! CALL mp_bcast( exst, ionode_id, intra_image_comm ) diff --git a/PHonon/PH/prepare_q.f90 b/PHonon/PH/prepare_q.f90 index 4f69ef491f..93829adf8e 100644 --- a/PHonon/PH/prepare_q.f90 +++ b/PHonon/PH/prepare_q.f90 @@ -123,7 +123,7 @@ SUBROUTINE prepare_q(auxdyn, do_band, do_iq, setup_pw, iq) ! ! ... each q /= gamma is saved on a different directory ! - IF (.NOT.lgamma.AND.lqdir) & + IF ((.NOT. lgamma .OR. ( iq /= 1)) .AND. lqdir) & tmp_dir_phq= TRIM (tmp_dir_ph) // TRIM(prefix) // '.q_' & & // TRIM(int_to_char(iq))//'/' ! From 35ebaff0c8bcd12dc0b912e5b24dea279b8e34dd Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrari Date: Fri, 28 Jun 2019 15:08:36 +0000 Subject: [PATCH 36/95] Two fixes in openMP variables --- Modules/xc_gga_drivers.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Modules/xc_gga_drivers.f90 b/Modules/xc_gga_drivers.f90 index 36b43464df..6b2f929d14 100644 --- a/Modules/xc_gga_drivers.f90 +++ b/Modules/xc_gga_drivers.f90 @@ -464,7 +464,7 @@ SUBROUTINE gcxc( length, rho_in, grho_in, sx_out, sc_out, v1x_out, & ! ! !$omp parallel if(ntids==1) -!$omp do private( rho, grho, sx, sx_, sxsr, v1x, v1x_, v1xsr, & +!$omp do private( rho, grho, sgn, sx, sx_, sxsr, v1x, v1x_, v1xsr, & !$omp v2x, v2x_, v2xsr, sc, v1c, v2c ) DO ir = 1, length ! @@ -798,7 +798,7 @@ SUBROUTINE gcx_spin( length, rho_in, grho2_in, sx_tot, v1x_out, v2x_out ) #endif ! !$omp parallel if(ntids==1) -!$omp do private( rho, grho2, sx, sxsr, v1x, v1xsr, & +!$omp do private( rho, grho2, rnull, sx, sxsr, v1x, v1xsr, & !$omp v2x, v2xsr ) DO ir = 1, length ! From 10a31a51c960178ebbeeedd9e2927a7735e1324c Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sat, 29 Jun 2019 08:25:51 +0200 Subject: [PATCH 37/95] More I/O cleanup: no need any longer to read dimensions first, allocate and read arrays later. --- CPV/src/cp_restart_new.f90 | 8 +-- Modules/qexsd_copy.f90 | 122 +++++++++++++++------------------ PW/src/input.f90 | 5 +- PW/src/read_conf_from_file.f90 | 11 ++- PW/src/read_file_new.f90 | 54 ++++++--------- 5 files changed, 85 insertions(+), 115 deletions(-) diff --git a/CPV/src/cp_restart_new.f90 b/CPV/src/cp_restart_new.f90 index 7d75e20ee8..7a6f6e9f36 100644 --- a/CPV/src/cp_restart_new.f90 +++ b/CPV/src/cp_restart_new.f90 @@ -806,8 +806,8 @@ SUBROUTINE cp_readfile( ndr, ascii, nfi, simtime, acc, nk, xk, & nbnd_ = nupdwn(1) ALLOCATE( occ_(nbnd_, nspin), et_(nbnd_, nspin) ) CALL qexsd_copy_band_structure( output_obj%band_structure, lsda_, & - nk_, isk_, natomwfc, nbnd_up, nbnd_dw, nelec_, wk_, occ_, & - ef, ef_up, ef_dw, et_ ) + nk_, isk_, natomwfc, nbnd, nbnd_up, nbnd_dw, nelec_, wk_, & + occ_, ef, ef_up, ef_dw, et_ ) ! FIXME: in the call, the same array is passed as both occ0 and occm! DO iss = 1, nspin ib = iupdwn(iss) @@ -1478,11 +1478,11 @@ SUBROUTINE cp_read_cell( ndr, tmp_dir, ascii, ht, & INTEGER :: ibrav_ INTEGER :: nat_ INTEGER :: nsp_ - INTEGER :: ityp_(nat) + INTEGER, ALLOCATABLE :: ityp_(:) REAL(DP) :: alat_ REAL(DP) :: a1_(3), a2_(3), a3_(3) REAL(DP) :: b1_(3), b2_(3), b3_(3) - REAL(DP) :: tau_(3,nat) + REAL(DP), ALLOCATABLE :: tau_(:,:) CHARACTER(LEN=3) :: atm_(ntypx) TYPE(output_type) :: output_obj TYPE(Node),POINTER :: root, simpleNode, timestepsNode, cellNode, stepNode diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index dc77775cc7..40c03f1ec3 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -19,7 +19,7 @@ MODULE qexsd_copy PRIVATE SAVE ! - PUBLIC:: qexsd_copy_geninfo, qexsd_copy_parallel_info, qexsd_copy_dim, & + PUBLIC:: qexsd_copy_geninfo, qexsd_copy_parallel_info, & qexsd_copy_atomic_species, qexsd_copy_atomic_structure, & qexsd_copy_symmetry, qexsd_copy_algorithmic_info, & qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure, & @@ -69,37 +69,6 @@ SUBROUTINE qexsd_copy_parallel_info (parinfo_obj, nproc_file, & END SUBROUTINE qexsd_copy_parallel_info ! !-------------------------------------------------------------------------- - SUBROUTINE qexsd_copy_dim (atomic_structure, band_structure, & - nat, nkstot, nbnd ) - ! - USE qes_types_module, ONLY : atomic_structure_type, band_structure_type - IMPLICIT NONE - ! - TYPE ( atomic_structure_type ),INTENT(IN) :: atomic_structure - TYPE ( band_structure_type ),INTENT(IN) :: band_structure - INTEGER, INTENT(OUT) :: nat, nkstot, nbnd - ! - LOGICAL :: lsda - ! - nat = atomic_structure%nat - nkstot = band_structure%nks - IF (band_structure%nbnd_ispresent) THEN - nbnd = band_structure%nbnd - ELSE IF ( band_structure%nbnd_up_ispresent .AND. band_structure%nbnd_dw_ispresent) THEN - nbnd = ( band_structure%nbnd_up + band_structure%nbnd_dw ) - ELSE - CALL errore('qexsd_copy_band_structure', & - 'nbnd or nbnd_up+nbnd_dw missing in xml file', 1) - END IF - lsda = band_structure%lsda - IF ( lsda ) THEN - nkstot = nkstot * 2 - nbnd = nbnd / 2 - END IF - - END SUBROUTINE qexsd_copy_dim - ! - !-------------------------------------------------------------------------- SUBROUTINE qexsd_copy_atomic_species (atomic_species, nsp, atm, amass, & starting_magnetization, angle1, angle2, psfile, pseudo_dir) !--------------------------------------------------------------------------- ! @@ -169,8 +138,10 @@ SUBROUTINE qexsd_copy_atomic_structure (atomic_structure, nsp, atm, & INTEGER, INTENT(in) :: nsp CHARACTER(LEN = 3), INTENT(in) :: atm(:) ! - INTEGER, INTENT(out) :: nat, ibrav, ityp(:) - REAL(dp), INTENT(out) :: alat, a1(:), a2(:), a3(:), tau(:,:) + INTEGER, INTENT(out) :: nat, ibrav + REAL(dp), INTENT(out) :: alat, a1(:), a2(:), a3(:) + INTEGER, INTENT(inout), ALLOCATABLE :: ityp(:) + REAL(dp), INTENT(inout), ALLOCATABLE :: tau(:,:) ! CHARACTER(LEN=3), ALLOCATABLE :: symbols(:) INTEGER :: iat, idx, isp @@ -182,6 +153,8 @@ SUBROUTINE qexsd_copy_atomic_structure (atomic_structure, nsp, atm, & ELSE ibrav = 0 END IF + IF ( .NOT. ALLOCATED(tau) ) ALLOCATE(tau(3,nat)) + IF ( .NOT. ALLOCATED(ityp)) ALLOCATE(ityp(nat)) ALLOCATE ( symbols(nat) ) loop_on_atoms:DO iat = 1, nat idx = atomic_structure%atomic_positions%atom(iat)%index @@ -472,7 +445,8 @@ END SUBROUTINE qexsd_copy_dft ! !------------------------------------------------------------------------ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & - isk, natomwfc, nbnd_up, nbnd_dw, nelec, wk, wg, ef, ef_up, ef_dw, et ) + isk, natomwfc, nbnd, nbnd_up, nbnd_dw, nelec, wk, wg, & + ef, ef_up, ef_dw, et ) !------------------------------------------------------------------------ ! ! IMPORTANT NOTICE: IN LSDA CASE CONVERTS TO "PWSCF" LOGIC for k-points @@ -482,32 +456,57 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & IMPLICIT NONE TYPE ( band_structure_type) :: band_struct_obj LOGICAL, INTENT(out) :: lsda - INTEGER, INTENT(out) :: nkstot, natomwfc, nbnd_up, nbnd_dw, isk(:) - REAL(dp), INTENT(out):: nelec, wk(:), wg(:,:) - REAL(dp), INTENT(out):: ef, ef_up, ef_dw, et(:,:) + INTEGER, INTENT(out) :: nkstot, natomwfc, nbnd, nbnd_up, nbnd_dw, & + isk(:) + REAL(dp), INTENT(out):: nelec, ef, ef_up, ef_dw, wk(:) + REAL(dp), INTENT(inout), ALLOCATABLE :: wg(:,:), et(:,:) ! - INTEGER :: ik, nbnd + INTEGER :: ik ! lsda = band_struct_obj%lsda nkstot = band_struct_obj%nks - IF ( lsda) THEN - ! FIXME: make this consistent with qexsd_copy_dim + nelec = band_struct_obj%nelec + natomwfc = band_struct_obj%num_of_atomic_wfc + ! + IF ( lsda) THEN + ! IF (band_struct_obj%nbnd_ispresent) THEN nbnd = band_struct_obj%nbnd / 2 ELSE IF ( band_struct_obj%nbnd_up_ispresent .AND. band_struct_obj%nbnd_dw_ispresent ) THEN nbnd = (band_struct_obj%nbnd_up + band_struct_obj%nbnd_dw)/2 ELSE CALL errore ('qexsd_copy_band_structure: ','both nbnd and nbnd_up+nbnd_dw missing', 1) - END IF + END IF + ! + IF ( band_struct_obj%nbnd_up_ispresent .AND. & + band_struct_obj%nbnd_dw_ispresent ) THEN + nbnd_up = band_struct_obj%nbnd_up + nbnd_dw = band_struct_obj%nbnd_dw + ELSE IF ( band_struct_obj%nbnd_up_ispresent ) THEN + nbnd_up = band_struct_obj%nbnd_up + nbnd_dw = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_up + ELSE IF ( band_struct_obj%nbnd_dw_ispresent ) THEN + nbnd_dw = band_struct_obj%nbnd_dw + nbnd_up = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_dw + ELSE + nbnd_up = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 + nbnd_dw = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 + END IF + ! nkstot = nkstot * 2 isk(1:nkstot/2) = 1 - isk(nkstot/2+1:nkstot) = 2 - ELSE + isk(nkstot/2+1:nkstot) = 2 + ELSE + IF (band_struct_obj%nbnd_ispresent) THEN + nbnd = band_struct_obj%nbnd + ELSE + CALL errore ('qexsd_copy_band_structure: ','nbnd missing', 1) + END IF + nbnd_up = nbnd + nbnd_dw = nbnd isk(1:nkstot) = 1 END IF ! - nelec = band_struct_obj%nelec - natomwfc = band_struct_obj%num_of_atomic_wfc IF ( band_struct_obj%fermi_energy_ispresent) THEN ef = band_struct_obj%fermi_energy ef_up = 0.d0 @@ -520,43 +519,30 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & ef = 0.d0 ef_up = 0.d0 ef_dw = 0.d0 - END IF - - IF ( band_struct_obj%lsda) THEN - IF ( band_struct_obj%nbnd_up_ispresent .AND. band_struct_obj%nbnd_dw_ispresent) THEN - nbnd_up = band_struct_obj%nbnd_up - nbnd_dw = band_struct_obj%nbnd_dw - ELSE IF ( band_struct_obj%nbnd_up_ispresent ) THEN - nbnd_up = band_struct_obj%nbnd_up - nbnd_dw = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_up - ELSE IF ( band_struct_obj%nbnd_dw_ispresent ) THEN - nbnd_dw = band_struct_obj%nbnd_dw - nbnd_up = band_struct_obj%ks_energies(ik)%eigenvalues%size - nbnd_dw - ELSE - nbnd_up = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 - nbnd_dw = band_struct_obj%ks_energies(ik)%eigenvalues%size/2 - END IF - END IF + END IF + ! + IF ( .NOT. ALLOCATED(et) ) ALLOCATE( et(nbnd,nkstot) ) + IF ( .NOT. ALLOCATED(wg) ) ALLOCATE( wg(nbnd,nkstot) ) ! DO ik =1, band_struct_obj%ndim_ks_energies IF ( band_struct_obj%lsda) THEN wk(ik) = band_struct_obj%ks_energies(ik)%k_point%weight - wk( ik + band_struct_obj%ndim_ks_energies ) = wk(ik) + wk(ik + band_struct_obj%ndim_ks_energies ) = wk(ik) et(1:nbnd_up,ik) = band_struct_obj%ks_energies(ik)%eigenvalues%vector(1:nbnd_up) et(1:nbnd_dw,ik+band_struct_obj%ndim_ks_energies) = & band_struct_obj%ks_energies(ik)%eigenvalues%vector(nbnd_up+1:nbnd_up+nbnd_dw) - wg(1:nbnd_up,ik) = band_struct_obj%ks_energies(ik)%occupations%vector(1:nbnd_up)*wk(ik) + wg(1:nbnd_up,ik) = & + band_struct_obj%ks_energies(ik)%occupations%vector(1:nbnd_up)*wk(ik) wg(1:nbnd_dw,ik+band_struct_obj%ndim_ks_energies) = & band_struct_obj%ks_energies(ik)%occupations%vector(nbnd_up+1:nbnd_up+nbnd_dw)*wk(ik) ELSE wk(ik) = band_struct_obj%ks_energies(ik)%k_point%weight - nbnd = band_struct_obj%ks_energies(ik)%eigenvalues%size et (1:nbnd,ik) = band_struct_obj%ks_energies(ik)%eigenvalues%vector(1:nbnd) wg (1:nbnd,ik) = band_struct_obj%ks_energies(ik)%occupations%vector(1:nbnd)*wk(ik) - nbnd_up = nbnd - nbnd_dw = nbnd END IF + ! END DO + ! END SUBROUTINE qexsd_copy_band_structure ! !----------------------------------------------------------------------- diff --git a/PW/src/input.f90 b/PW/src/input.f90 index ed10a7a13b..88497554eb 100644 --- a/PW/src/input.f90 +++ b/PW/src/input.f90 @@ -1447,13 +1447,12 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) ! ! ... Read atomic positions and unit cell from data file, if needed, ! ... overwriting what has just been read before from input + ! ... read_config_from_file returns 0 if structure successfully read ! ierr = 1 IF ( startingconfig == 'file' .AND. .NOT. lforcet ) & - ierr = read_config_from_file(nat, at_old, omega_old, lmovecell, & - at, bg, omega, tau) + ierr = read_config_from_file( lmovecell, at_old, omega_old) ! - ! ... read_config_from_file returns 0 if structure successfully read ! ... Atomic positions (tau) must be converted to internal units ! ... only if they were read from input, not from file ! diff --git a/PW/src/read_conf_from_file.f90 b/PW/src/read_conf_from_file.f90 index 6b2bfb323a..97337e8a9f 100644 --- a/PW/src/read_conf_from_file.f90 +++ b/PW/src/read_conf_from_file.f90 @@ -7,17 +7,17 @@ ! ! !----------------------------------------------------------------------- -FUNCTION read_config_from_file(nat, at_old, omega_old, lmovecell, at, bg, & - omega, tau) RESULT (ierr) +FUNCTION read_config_from_file( lmovecell, at_old, omega_old ) RESULT (ierr) !----------------------------------------------------------------------- ! FIXME: half of the variables are passed as arguments, half in modules + ! FIXME: this routines does two different things ! USE kinds, ONLY : DP USE io_global, ONLY : stdout USE io_files, ONLY : tmp_dir, prefix, postfix, & psfile, pseudo_dir, pseudo_dir_cur - USE ions_base, ONLY : nsp, ityp, amass, atm - USE cell_base, ONLY : alat, ibrav + USE ions_base, ONLY : nat, nsp, ityp, amass, atm, tau + USE cell_base, ONLY : alat, ibrav, at, bg, omega USE pw_restart_new, ONLY : pw_read_schema USE qexsd_copy, ONLY : qexsd_copy_atomic_species, & qexsd_copy_atomic_structure @@ -27,10 +27,7 @@ FUNCTION read_config_from_file(nat, at_old, omega_old, lmovecell, at, bg, & IMPLICIT NONE ! LOGICAL,INTENT(in) :: lmovecell - INTEGER,INTENT(in) :: nat REAL(DP),INTENT(inout) :: at_old(3,3), omega_old - REAL(DP),INTENT(inout) :: at(3,3), bg(3,3), omega - REAL(DP),INTENT(inout) :: tau(3,nat) INTEGER :: ierr, nat_ ! TYPE ( output_type) :: output_obj diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 40ca370a7d..17180f61f3 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -144,7 +144,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) general_info_type, input_type USE qes_libs_module, ONLY : qes_reset USE qexsd_copy, ONLY : qexsd_copy_parallel_info, & - qexsd_copy_dim, qexsd_copy_atomic_species, & + qexsd_copy_atomic_species, & qexsd_copy_atomic_structure, qexsd_copy_symmetry, & qexsd_copy_basis_set, qexsd_copy_algorithmic_info,& qexsd_copy_dft, qexsd_copy_efield, qexsd_copy_band_structure @@ -182,41 +182,15 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL pw_read_schema ( ierr, output_obj, parinfo_obj, geninfo_obj, input_obj) IF ( ierr /= 0 ) CALL errore ( 'read_schema', 'unable to read xml file', abs(ierr) ) #endif - wfc_is_collected = output_obj%band_structure%wf_collected ! - ! ... here we read the variables that dimension the system + ! ... Now read all needed variables from xml objects + ! + wfc_is_collected = output_obj%band_structure%wf_collected + lvalid_input = (TRIM(input_obj%tagname) == "input") ! CALL qexsd_copy_parallel_info (parinfo_obj, nproc_file, & nproc_pool_file, nproc_image_file, ntask_groups_file, & nproc_bgrp_file, nproc_ortho_file) - CALL qexsd_copy_dim ( output_obj%atomic_structure, & - output_obj%band_structure, nat, nkstot, nbnd ) - ! - ! ... until pools are activated, the local number of k-points nks - ! ... should be equal to the global number nkstot - k-points are replicated - ! - nks = nkstot - ! - ! ... allocate space for arrays to be read in this routine - ! - ! ... atomic positions, forces, symmetries - ! - IF ( nat < 0 ) CALL errore( 'read_xml_file', 'wrong number of atoms', 1 ) - ALLOCATE( ityp( nat ) ) - ALLOCATE( tau( 3, nat ) ) - ALLOCATE( force ( 3, nat ) ) - ALLOCATE( extfor( 3, nat ) ) - IF ( tefield ) ALLOCATE( forcefield( 3, nat ) ) - IF ( gate ) ALLOCATE( forcegate( 3, nat ) ) - ALLOCATE( irt( 48, nat ) ) - ! - ! ... eigenvalues, weights - ! - ALLOCATE( et( nbnd, nkstot ) , wg( nbnd, nkstot ) ) - ! - ! ... here we read all the variables defining the system - ! - lvalid_input = (TRIM(input_obj%tagname) == "input") ! pseudo_dir_cur = TRIM( tmp_dir ) // TRIM( prefix ) // postfix CALL qexsd_copy_atomic_species ( output_obj%atomic_species, & @@ -224,6 +198,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) psfile, pseudo_dir ) IF ( pseudo_dir == ' ' ) pseudo_dir=pseudo_dir_cur !! Atomic structure section + !! tau and ityp are allocated inside qexsd_copy_atomic_structure + ! CALL qexsd_copy_atomic_structure (output_obj%atomic_structure, nsp, & atm, nat, tau, ityp, alat, at(:,1), at(:,2), at(:,3), ibrav ) ! @@ -262,20 +238,27 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL start_exx () END IF !! Band structure section + !! et and wg are allocated inside qexsd_copy_band_structure CALL qexsd_copy_band_structure( output_obj%band_structure, lsda, & - nkstot, isk, natomwfc, nupdwn(1), nupdwn(2), nelec, wk, wg, & + nkstot, isk, natomwfc, nbnd, nupdwn(1), nupdwn(2), nelec, wk, wg, & ef, ef_up, ef_dw, et ) ! convert to Ry ef = ef*e2 ef_up = ef_up*e2 ef_dw = ef_dw*e2 et(:,:) = et(:,:)*e2 + ! + ! ... until pools are activated, the local number of k-points nks + ! ... should be equal to the global number nkstot - k-points are replicated + ! + nks = nkstot !! CALL readschema_magnetization ( output_obj%band_structure, & output_obj%magnetization ) CALL readschema_occupations( output_obj%band_structure ) CALL readschema_brillouin_zone( output_obj%band_structure ) !! Symmetry section + ALLOCATE ( irt(48,nat) ) IF ( lvalid_input ) THEN CALL qexsd_copy_symmetry ( output_obj%symmetries, & nsym, nrot, s, ft, sname, t_rev, invsym, irt, & @@ -297,7 +280,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) CALL s_axis_to_cart() !! symmetry check - FIXME: is this needed? IF (nat > 0) CALL checkallsym( nat, tau, ityp) - ! + !! Algorithmic info do_cutoff_2D = (output_obj%boundary_conditions%assume_isolated == "2D") CALL qexsd_copy_algorithmic_info ( output_obj%algorithmic_info, & real_space, tqr, okvan, okpaw ) @@ -311,6 +294,11 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! ! END OF READING VARIABLES FROM XML DATA FILE ! + ALLOCATE( force ( 3, nat ) ) + ALLOCATE( extfor( 3, nat ) ) + IF ( tefield ) ALLOCATE( forcefield( 3, nat ) ) + IF ( gate ) ALLOCATE( forcegate( 3, nat ) ) + ! END SUBROUTINE read_xml_file ! !---------------------------------------------------------------------------- From 619370e7daf570182ca453bcc00daa0ef7bae8f0 Mon Sep 17 00:00:00 2001 From: Pietro Date: Sun, 30 Jun 2019 16:11:05 +0000 Subject: [PATCH 38/95] Skip utilxlib test if branch name does not contain 'utilxlib' word --- .ci/cineca.yml | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/.ci/cineca.yml b/.ci/cineca.yml index 5a383370c3..cecb5f0291 100644 --- a/.ci/cineca.yml +++ b/.ci/cineca.yml @@ -1,6 +1,11 @@ -# UtilXlib UnitTesting +# ==================== +# UtilXlib UnitTesting +# ==================== + build:cudampiomp: tags: [galileo] + only: + - /utilxlib/i script: - module load profile/advanced pgi/17.10 cuda/8.0.61 - ./configure --enable-openmp @@ -9,6 +14,8 @@ build:cudampiomp: build:intelmpiomp: tags: [galileo] + only: + - /utilxlib/i script: - module load profile/advanced intel intelmpi - ./configure --enable-openmp @@ -17,6 +24,8 @@ build:intelmpiomp: build:cudampi: tags: [galileo] + only: + - /utilxlib/i script: - module load profile/advanced pgi/17.10 cuda/8.0.61 - ./configure @@ -25,6 +34,8 @@ build:cudampi: build:intelmpi: tags: [galileo] + only: + - /utilxlib/i script: - module load profile/advanced intel intelmpi - ./configure @@ -103,10 +114,6 @@ build:cudafortran: - module purge - module load profile/global pgi/17.10 cuda/8.0.61 - module list - #- git checkout develop - #- git merge -X ours --no-edit origin/configcuda - #- git merge -X theirs --no-edit origin/mpicuda - #- git merge -X theirs --no-edit origin/cudadiag - ./configure --enable-openmp --with-cuda=$CUDA_HOME - make pw cp - make clean From 57129bc7a6263f2334652c3407ecf6361ac1251e Mon Sep 17 00:00:00 2001 From: Pietro Date: Sun, 30 Jun 2019 16:12:32 +0000 Subject: [PATCH 39/95] Fixed logic of recently added non-blocking mp_circular_shift_left_* for serial case. --- UtilXlib/mp.f90 | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/UtilXlib/mp.f90 b/UtilXlib/mp.f90 index 05397ccb34..31606ac199 100644 --- a/UtilXlib/mp.f90 +++ b/UtilXlib/mp.f90 @@ -2533,7 +2533,9 @@ SUBROUTINE mp_circular_shift_left_start_i0( sendbuf, recvbuf, itag, gid, request IF (ierr/=0) CALL mp_stop( 8103 ) ! #else - ! do nothing + + recvbuf = sendbuf + #endif RETURN END SUBROUTINE mp_circular_shift_left_start_i0 @@ -2575,7 +2577,9 @@ SUBROUTINE mp_circular_shift_left_start_i1( sendbuf, recvbuf, itag, gid, request IF (ierr/=0) CALL mp_stop( 8103 ) ! #else - ! do nothing + + recvbuf = sendbuf + #endif RETURN END SUBROUTINE mp_circular_shift_left_start_i1 @@ -2617,7 +2621,9 @@ SUBROUTINE mp_circular_shift_left_start_i2( sendbuf, recvbuf, itag, gid, request IF (ierr/=0) CALL mp_stop( 8103 ) ! #else - ! do nothing + + recvbuf = sendbuf + #endif RETURN END SUBROUTINE mp_circular_shift_left_start_i2 @@ -2659,7 +2665,9 @@ SUBROUTINE mp_circular_shift_left_start_r2d( sendbuf, recvbuf, itag, gid, reques IF (ierr/=0) CALL mp_stop( 8103 ) ! #else - ! do nothing + + recvbuf = sendbuf + #endif RETURN END SUBROUTINE mp_circular_shift_left_start_r2d @@ -2701,7 +2709,9 @@ SUBROUTINE mp_circular_shift_left_start_c2d( sendbuf, recvbuf, itag, gid, reques IF (ierr/=0) CALL mp_stop( 8103 ) ! #else - ! do nothing + + recvbuf = sendbuf + #endif RETURN END SUBROUTINE mp_circular_shift_left_start_c2d From 72a24c4142ef44e365afc0b1074523a78e79d44d Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Mon, 1 Jul 2019 17:28:05 +0200 Subject: [PATCH 40/95] Minor fixes in Modules/funct.f90 --- Modules/funct.f90 | 128 ++++++++++++++++++++++++---------------------- 1 file changed, 68 insertions(+), 60 deletions(-) diff --git a/Modules/funct.f90 b/Modules/funct.f90 index 9a6ca40327..d22dcc57ec 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -654,14 +654,14 @@ SUBROUTINE set_dft_from_name( dft_ ) iexch = matching( 1, dftout, nxc, exc, is_libxc(1) ) icorr = matching( 2, dftout, ncc, corr, is_libxc(2) ) igcx = matching( 3, dftout, ngcx, gradx, is_libxc(3) ) - igcc = matching( 4, dftout, ngcc, gradc, is_libxc(4) ) + igcc = matching( 4, dftout, ngcc, gradc, is_libxc(4) ) imeta = matching( 5, dftout, nmeta, meta, is_libxc(5) ) IF ( is_libxc(5) ) THEN imetac = matching( 6, dftout, nmeta, meta, is_libxc(6) ) ELSE imetac = 0 ENDIF - inlc = matching( 7, dftout, ncnl, nonlocc, is_libxc(7) ) + inlc = matching( 7, dftout, ncnl, nonlocc, is_libxc(7) ) ! #if defined(__LIBXC) fkind = -100 @@ -685,10 +685,13 @@ SUBROUTINE set_dft_from_name( dft_ ) CALL errore( 'set_dft_from_name', 'An EXCHANGE+CORRELATION functional has & &been found together with a correlation one', 3 ) ! - IF (ANY(is_libxc(1:2)) .AND. ANY(is_libxc(3:4))) & + IF ( (is_libxc(3).AND.iexch/=0) .OR. (is_libxc(4).AND. icorr/=0) ) THEN CALL errore( 'set_dft_from_name', 'An LDA functional has been found, but & &libxc GGA functionals already include the LDA part)', 4 ) + ENDIF ! + ! ... at the moment, for q-e functionals, imeta defines both exchange and + ! correlation part. IF (imeta/=0 .AND. (.NOT. is_libxc(5)) .AND. imetac/=0) & CALL errore( 'set_dft_from_name', 'Two conflicting metaGGA functionals & &have been found', 5 ) @@ -787,7 +790,7 @@ FUNCTION matching( fslot, dft, n, name, its_libxc ) CHARACTER(LEN=*), INTENT(IN):: name(0:n) CHARACTER(LEN=*), INTENT(IN):: dft LOGICAL, EXTERNAL :: matches - INTEGER :: i, ii, j, length + INTEGER :: i, k, ii, j, length INTEGER :: family, fkind #if defined(__LIBXC) TYPE(xc_f90_pointer_t) :: xc_func, xc_info @@ -796,57 +799,62 @@ FUNCTION matching( fslot, dft, n, name, its_libxc ) its_libxc = .FALSE. matching = notset ! - IF (matching == notset) THEN - ! - length = LEN( dft ) + length = LEN( dft ) + ! + ii = 0 + ! + DO i = 1, length + ii = ii+1 + IF (ii == length-1) EXIT ! - ii = 0 + IF ( ii==1 .OR. (ii>1 .AND. dft(ii-1:ii-1).EQ.' ') ) THEN + DO j = 1, length-ii + IF (dft(ii+j:ii+j) .EQ. ' ') EXIT + ENDDO + ENDIF ! - DO i = 1, length - ii = ii+1 - IF (ii == length-1) EXIT + IF (dft(ii:ii+2) .EQ. 'XC_') THEN ! - IF (dft(ii:ii+2) .EQ. 'XC_') THEN - DO j = 1, length-ii-2 - IF (dft(ii+2+j:ii+2+j) .EQ. ' ') EXIT - ENDDO - ! #if defined(__LIBXC) - matching = xc_f90_functional_get_number( dft(ii:ii+1+j) ) - ! - CALL xc_f90_func_init( xc_func, xc_info, matching, 1 ) - family = xc_f90_info_family( xc_info ) - fkind = xc_f90_info_kind( xc_info ) - CALL xc_f90_func_end( xc_func ) - ! - IF ( slot_match_libxc( fslot, family, fkind ) ) THEN - its_libxc = .TRUE. - RETURN - ENDIF + matching = xc_f90_functional_get_number( dft(ii:ii+j-1) ) + IF (matching == -1) CALL errore( 'matching', 'Unrecognized libxc functional', 1 ) + ! + CALL xc_f90_func_init( xc_func, xc_info, matching, 1 ) + family = xc_f90_info_family( xc_info ) + fkind = xc_f90_info_kind( xc_info ) + CALL xc_f90_func_end( xc_func ) + ! + IF ( slot_match_libxc( fslot, family, fkind ) ) THEN + its_libxc = .TRUE. + RETURN + ELSE + matching = notset + ENDIF #else - CALL errore( 'matching', 'A libxc functional has been found, & - &but libxc library is not active', 1 ) + CALL errore( 'matching', 'A libxc functional has been found, & + &but libxc library is not active', 2 ) #endif - ii = ii+2+j - ENDIF ! - ENDDO + ELSE + ! + DO k = n, 0, -1 + IF ( matches(name(k), dft(ii:ii+j-1)) ) THEN + IF ( matching == notset ) THEN + ! write(*, '("matches",i2,2X,A,2X,A)') k, name(k), trim(dft) + matching = k + ELSE + WRITE(*, '(2(2X,i2,2X,A))') k, TRIM(name(k)), & + matching, TRIM(name(matching)) + CALL errore( 'set_dft', 'two conflicting matching values', 3 ) + ENDIF + ENDIF + ENDDO + IF (matching /= notset) RETURN + ! + ENDIF ! - matching = notset + ii = ii+j ! - ENDIF - ! - DO i = n, 0, -1 - IF ( matches(name(i), TRIM(dft)) ) THEN - IF ( matching == notset ) THEN - ! write(*, '("matches",i2,2X,A,2X,A)') i, name(i), trim(dft) - matching = i - ELSE - WRITE(*, '(2(2X,i2,2X,A))') i, TRIM(name(i)), & - matching, TRIM(name(matching)) - CALL errore( 'set_dft', 'two conflicting matching values', 2 ) - ENDIF - ENDIF ENDDO ! IF (matching == notset) matching = 0 @@ -868,24 +876,24 @@ FUNCTION slot_match_libxc( fslot, family, fkind ) ! SELECT CASE( fslot ) CASE( 1 ) - IF (family==XC_FAMILY_LDA .AND. fkind==XC_EXCHANGE) RETURN - IF (family==XC_FAMILY_LDA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN + IF (family==XC_FAMILY_LDA .AND. fkind==XC_EXCHANGE) RETURN + IF (family==XC_FAMILY_LDA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN CASE( 2 ) - IF (family==XC_FAMILY_LDA .AND. fkind==XC_CORRELATION) RETURN + IF (family==XC_FAMILY_LDA .AND. fkind==XC_CORRELATION) RETURN CASE( 3 ) - IF (family==XC_FAMILY_GGA .AND. fkind==XC_EXCHANGE) RETURN - IF (family==XC_FAMILY_GGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN - IF (family==XC_FAMILY_HYB_GGA .AND. fkind==XC_EXCHANGE) RETURN - IF (family==XC_FAMILY_HYB_GGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN + IF (family==XC_FAMILY_GGA .AND. fkind==XC_EXCHANGE) RETURN + IF (family==XC_FAMILY_GGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN + IF (family==XC_FAMILY_HYB_GGA .AND. fkind==XC_EXCHANGE) RETURN + IF (family==XC_FAMILY_HYB_GGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN CASE( 4 ) - IF (family==XC_FAMILY_GGA .AND. fkind==XC_CORRELATION) RETURN + IF (family==XC_FAMILY_GGA .AND. fkind==XC_CORRELATION) RETURN CASE( 5 ) - IF (family==XC_FAMILY_MGGA .AND. fkind==XC_EXCHANGE) RETURN - IF (family==XC_FAMILY_MGGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN - IF (family==XC_FAMILY_HYB_MGGA .AND. fkind==XC_EXCHANGE) RETURN + IF (family==XC_FAMILY_MGGA .AND. fkind==XC_EXCHANGE) RETURN + IF (family==XC_FAMILY_MGGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN + IF (family==XC_FAMILY_HYB_MGGA .AND. fkind==XC_EXCHANGE) RETURN IF (family==XC_FAMILY_HYB_MGGA .AND. fkind==XC_EXCHANGE_CORRELATION) RETURN CASE( 6 ) - IF (family==XC_FAMILY_MGGA .AND. fkind==XC_CORRELATION) RETURN + IF (family==XC_FAMILY_MGGA .AND. fkind==XC_CORRELATION) RETURN END SELECT #endif ! @@ -1415,8 +1423,8 @@ END FUNCTION get_dft_long !----------------------------------------------------------------------- SUBROUTINE write_dft_name !----------------------------------------------------------------------- - WRITE( stdout, '(5X,"Exchange-correlation = ",A, & - & " (",I2,3I3,2I2,")")') TRIM( dft ), iexch,icorr,igcx,igcc,inlc,imeta + WRITE( stdout, '(5X,"Exchange-correlation= ",A)') TRIM( dft ) + WRITE( stdout, '(27X,"(",I4,3I4,3I4,")")' ) iexch, icorr, igcx, igcc, inlc, imeta, imetac IF ( get_exx_fraction() > 0.0_dp ) WRITE( stdout, & '(5X,"EXX-fraction =",F12.2)') get_exx_fraction() RETURN From 9e470570eca9a2a81a74fb7021089e2828f25a5d Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrari Date: Tue, 2 Jul 2019 11:43:55 +0000 Subject: [PATCH 41/95] Another fix for openMP variables in lda drivers --- Modules/xc_lda_lsda_drivers.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Modules/xc_lda_lsda_drivers.f90 b/Modules/xc_lda_lsda_drivers.f90 index 996bbdb78f..4afec47c0a 100644 --- a/Modules/xc_lda_lsda_drivers.f90 +++ b/Modules/xc_lda_lsda_drivers.f90 @@ -324,7 +324,7 @@ SUBROUTINE xc_lda( length, rho_in, ex_out, ec_out, vx_out, vc_out ) ENDIF ! !$omp parallel if(ntids==1) -!$omp do private( rho, rs, ex, ec, ec_, vx, vc, vc_, exx_fraction ) +!$omp do private( rho, rs, ex, ec, ec_, vx, vc, vc_ ) DO ir = 1, length ! rho = ABS(rho_in(ir)) @@ -542,7 +542,7 @@ SUBROUTINE xc_lsda( length, rho_in, zeta_in, ex_out, ec_out, vx_out, vc_out ) exx_fraction = get_exx_fraction() ! !$omp parallel if(ntids==1) -!$omp do private( rho, rs, zeta, ex, ec, ec_, vx, vc, vc_, exx_fraction ) +!$omp do private( rho, rs, zeta, ex, ec, ec_, vx, vc, vc_ ) DO ir = 1, length ! zeta = zeta_in(ir) From 03d658a85a32041875488ce8462490b5c24bc0fb Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Fri, 5 Jul 2019 21:51:12 +0200 Subject: [PATCH 42/95] plot_num=1 wasn't working any longer as expected: local potential was missing. Also: spin_component=0 should yield the spin-averaged potential --- Doc/release-notes | 2 ++ PP/src/punch_plot.f90 | 9 ++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/Doc/release-notes b/Doc/release-notes index 9dd0f404c7..90b0d4b339 100644 --- a/Doc/release-notes +++ b/Doc/release-notes @@ -4,6 +4,8 @@ New in development branch: Nathalie Vast). lr_sm1_psi.f90 of LR_Modules is rewritten and simplified. Problems fixed in development branch : + * PP: plot_num=1 wasn't working any longer as expected + due to forgotten local potential term * DOS calculation wasn't honoring "bz_sum='smearing'" if the nscf calculation was performed with tetrahedra, contrary to what stated in the documentation (noticed by Mohammedreza Hosseini, Modares Univ.) diff --git a/PP/src/punch_plot.f90 b/PP/src/punch_plot.f90 index 1eb1e47420..283db433ab 100644 --- a/PP/src/punch_plot.f90 +++ b/PP/src/punch_plot.f90 @@ -95,13 +95,14 @@ SUBROUTINE punch_plot (filplot, plot_num, sample_bias, z, dz, & ! ! The total self-consistent potential V_H+V_xc on output ! - raux(:) = v%of_r(:,1) IF ( lsda ) THEN IF ( spin_component == 0 ) THEN - raux(:) = raux(:) + v%of_r(:,nspin) + raux(:) = (v%of_r(:,1) + v%of_r(:,2))/2.0_dp + vltot(:) ELSE - raux(:) = v%of_r(:,spin_component) + raux(:) = v%of_r(:,spin_component) + vltot(:) END IF + ELSE + raux(:) = v%of_r(:,1) + vltot(:) END IF ! ELSEIF (plot_num == 2) THEN @@ -182,8 +183,6 @@ SUBROUTINE punch_plot (filplot, plot_num, sample_bias, z, dz, & raux(:) = (raux(:) + rho%of_r(:,nspin))/2.0_dp ELSE IF ( spin_component == 2 ) THEN raux(:) = (raux(:) - rho%of_r(:,nspin))/2.0_dp - !ELSE - ! CALL errore('punch_plot','spin_component not allowed',1) END IF ENDIF From 01adfa40d61cfa3095a3db58df2d3a0707830180 Mon Sep 17 00:00:00 2001 From: Ronald Cohen Date: Mon, 8 Jul 2019 15:44:52 +0200 Subject: [PATCH 43/95] add more digits for printing pressure stress and energy for extreme conditions --- PW/src/dynamics_module.f90 | 8 ++++---- PW/src/stress.f90 | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/PW/src/dynamics_module.f90 b/PW/src/dynamics_module.f90 index 43f03999a0..90535bf432 100644 --- a/PW/src/dynamics_module.f90 +++ b/PW/src/dynamics_module.f90 @@ -371,12 +371,12 @@ SUBROUTINE verlet() ! ! ... infos are written on the standard output ! - WRITE( stdout, '(5X,"kinetic energy (Ekin) = ",F14.8," Ry",/, & - & 5X,"temperature = ",F14.8," K ",/, & - & 5X,"Ekin + Etot (const) = ",F14.8," Ry")' ) & + WRITE( stdout, '(5X,"kinetic energy (Ekin) = ",F20.8," Ry",/, & + & 5X,"temperature = ",F20.8," K ",/, & + & 5X,"Ekin + Etot (const) = ",F20.8," Ry")' ) & ekin, temp_new, ( ekin + etot ) IF (lstres) WRITE ( stdout, & - '(5X,"Ions kinetic stress = ",F10.2," (kbar)",/3(27X,3F10.2/)/)') & + '(5X,"Ions kinetic stress = ",F15.2," (kbar)",/3(27X,3F15.2/)/)') & ((kstress(1,1)+kstress(2,2)+kstress(3,3))/3.d0*ry_kbar), & (kstress(i,1)*ry_kbar,kstress(i,2)*ry_kbar,kstress(i,3)*ry_kbar, i=1,3) ! diff --git a/PW/src/stress.f90 b/PW/src/stress.f90 index 6b275dfe34..d942192052 100644 --- a/PW/src/stress.f90 +++ b/PW/src/stress.f90 @@ -195,7 +195,7 @@ subroutine stress ( sigma ) CALL symmatrix ( sigma ) ! - ! write results in Ry/(a.u.)^3 and in kbar + ! write results in Ryd/(a.u.)^3 and in kbar ! IF ( do_comp_esm .and. ( esm_bc .ne. 'pbc' ) ) THEN ! for ESM stress write( stdout, 9000) (sigma(1,1) + sigma(2,2)) * ry_kbar/3d0, & @@ -238,8 +238,8 @@ subroutine stress ( sigma ) call stop_clock ('stress') return -9000 format (10x,'total stress (Ry/bohr**3) ',18x,'(kbar)', & - &5x,'P=',f8.2/3 (3f13.8,4x,3f10.2/)) +9000 format (10x,'total stress (Ryd/bohr**3) ',18x,'(kbar)', & + &5x,'P=',f12.2/3 (3f13.8,4x,3f12.2/)) 9005 format & & (5x,'kinetic stress (kbar)',3f10.2/2(26x,3f10.2/)/ & & 5x,'local stress (kbar)',3f10.2/2(26x,3f10.2/)/ & From c76c1bda4c940c552297f55d5575213327dbfd45 Mon Sep 17 00:00:00 2001 From: Ronald Cohen Date: Mon, 8 Jul 2019 18:26:53 +0200 Subject: [PATCH 44/95] change Ryd to Ry --- PW/src/add_bfield.f90 | 2 +- PW/src/stress.f90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/PW/src/add_bfield.f90 b/PW/src/add_bfield.f90 index d6d923a993..985f1e6fc1 100644 --- a/PW/src/add_bfield.f90 +++ b/PW/src/add_bfield.f90 @@ -105,7 +105,7 @@ SUBROUTINE add_bfield (v,rho) end if deallocate (m2, m_loc, r_loc) - write (stdout,'(4x,a,F15.8)' ) " constraint energy (Ryd) = ", etcon + write (stdout,'(4x,a,F15.8)' ) " constraint energy (Ry) = ", etcon ELSE IF (i_cons==3.or.i_cons==6) THEN m1 = 0.d0 DO ipol = 1, npol diff --git a/PW/src/stress.f90 b/PW/src/stress.f90 index d942192052..d90cde76c5 100644 --- a/PW/src/stress.f90 +++ b/PW/src/stress.f90 @@ -195,7 +195,7 @@ subroutine stress ( sigma ) CALL symmatrix ( sigma ) ! - ! write results in Ryd/(a.u.)^3 and in kbar + ! write results in Ry/(a.u.)^3 and in kbar ! IF ( do_comp_esm .and. ( esm_bc .ne. 'pbc' ) ) THEN ! for ESM stress write( stdout, 9000) (sigma(1,1) + sigma(2,2)) * ry_kbar/3d0, & @@ -238,7 +238,7 @@ subroutine stress ( sigma ) call stop_clock ('stress') return -9000 format (10x,'total stress (Ryd/bohr**3) ',18x,'(kbar)', & +9000 format (10x,'total stress (Ry/bohr**3) ',18x,'(kbar)', & &5x,'P=',f12.2/3 (3f13.8,4x,3f12.2/)) 9005 format & & (5x,'kinetic stress (kbar)',3f10.2/2(26x,3f10.2/)/ & From 078fc9fdbedcc4fbb9dd057a02e20005c56da437 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Tue, 9 Jul 2019 17:32:45 +0200 Subject: [PATCH 45/95] Minor documentation updates and source cleanup --- Doc/release-notes | 4 ++-- PP/Doc/INPUT_PP.def | 17 +++++++++++++++++ PP/src/punch_plot.f90 | 18 +++++++----------- 3 files changed, 26 insertions(+), 13 deletions(-) diff --git a/Doc/release-notes b/Doc/release-notes index 90b0d4b339..3c46e71fec 100644 --- a/Doc/release-notes +++ b/Doc/release-notes @@ -4,8 +4,8 @@ New in development branch: Nathalie Vast). lr_sm1_psi.f90 of LR_Modules is rewritten and simplified. Problems fixed in development branch : - * PP: plot_num=1 wasn't working any longer as expected - due to forgotten local potential term + * PP: plot_num=1 wasn't working any longer as expected due to forgotten + local potential term (noticed by Manoar Hossain, NISER) * DOS calculation wasn't honoring "bz_sum='smearing'" if the nscf calculation was performed with tetrahedra, contrary to what stated in the documentation (noticed by Mohammedreza Hosseini, Modares Univ.) diff --git a/PP/Doc/INPUT_PP.def b/PP/Doc/INPUT_PP.def index 05394528b8..2883d141c2 100644 --- a/PP/Doc/INPUT_PP.def +++ b/PP/Doc/INPUT_PP.def @@ -122,6 +122,7 @@ input_description -distribution {Quantum Espresso} -package PWscf -program pp.x 21 = all-electron charge density (valence+core). For PAW calculations only; requires a very dense real-space grid. + 22 = kinetic energy density (for meta-GGA and XDM only) } } @@ -327,6 +328,22 @@ input_description -distribution {Quantum Espresso} -package PWscf -program pp.x } } + elsewhen -test "plot_num=22" { + label { + Options for kinetic energy density (plot_num=22), + LSDA case only: + } + + var spin_component -type INTEGER { + default 0 + info { + 0 = total density (default value), + 1 = spin up density, + 2 = spin down density. + } + } + } + #message { # Unfinished and untested option: # diff --git a/PP/src/punch_plot.f90 b/PP/src/punch_plot.f90 index 283db433ab..59a9295736 100644 --- a/PP/src/punch_plot.f90 +++ b/PP/src/punch_plot.f90 @@ -93,7 +93,7 @@ SUBROUTINE punch_plot (filplot, plot_num, sample_bias, z, dz, & ! ELSEIF (plot_num == 1) THEN ! - ! The total self-consistent potential V_H+V_xc on output + ! The total self-consistent potential V_loc+V_H+V_xc ! IF ( lsda ) THEN IF ( spin_component == 0 ) THEN @@ -109,7 +109,7 @@ SUBROUTINE punch_plot (filplot, plot_num, sample_bias, z, dz, & ! ! The local pseudopotential on output ! - CALL dcopy (dfftp%nnr, vltot, 1, raux, 1) + raux(:) = vltot(:) ! ELSEIF (plot_num == 3) THEN ! @@ -278,18 +278,14 @@ SUBROUTINE punch_plot (filplot, plot_num, sample_bias, z, dz, & ! ! plot of the kinetic energy density ! - IF (noncolin) THEN - CALL dcopy (dfftp%nnr, rho%kin_r, 1, raux, 1) - ELSE + IF ( lsda ) THEN IF (spin_component == 0) THEN - CALL dcopy (dfftp%nnr, rho%kin_r (1, 1), 1, raux, 1) - DO is = 2, nspin - CALL daxpy (dfftp%nnr, 1.d0, rho%kin_r (1, is), 1, raux, 1) - ENDDO + raux(:) = rho%kin_r(:,1)+rho%kin_r(:,2) ELSE - CALL dcopy (dfftp%nnr, rho%kin_r (1, spin_component), 1, raux, 1) - CALL dscal (dfftp%nnr, 0.5d0 * nspin, raux, 1) + raux(:) = rho%kin_r(:, spin_component) ENDIF + ELSE + raux(:) = rho%kin_r(:,1) ENDIF ELSE From 5d91f395e9d13b4c50bd3574a5cb766853b21ef2 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Wed, 10 Jul 2019 13:49:28 +0200 Subject: [PATCH 46/95] Some more I/O cleanup --- Modules/qexsd_copy.f90 | 23 +++++++++++++++++- PW/src/pw_restart_new.f90 | 51 +-------------------------------------- PW/src/read_file_new.f90 | 37 +++++++++++++++++++--------- 3 files changed, 49 insertions(+), 62 deletions(-) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 40c03f1ec3..0eaa688658 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -23,7 +23,7 @@ MODULE qexsd_copy qexsd_copy_atomic_species, qexsd_copy_atomic_structure, & qexsd_copy_symmetry, qexsd_copy_algorithmic_info, & qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure, & - qexsd_copy_efield + qexsd_copy_efield, qexsd_copy_magnetization ! CONTAINS !------------------------------------------------------------------------------- @@ -626,4 +626,25 @@ SUBROUTINE qexsd_copy_efield ( efield_obj, tefield, dipfield, edir, & ! END SUBROUTINE qexsd_copy_efield ! + !-------------------------------------------------------------------------- + SUBROUTINE qexsd_copy_magnetization ( magnetization_obj, & + lsda, noncolin, lspinorb, domag, tot_magnetization ) + !------------------------------------------------------------------------ + ! + USE qes_types_module, ONLY : magnetization_type + ! + IMPLICIT NONE + ! + TYPE ( magnetization_type ) ,INTENT(IN) :: magnetization_obj + LOGICAL, INTENT(OUT) :: lsda, noncolin, lspinorb, domag + REAL(dp), INTENT(OUT) :: tot_magnetization + ! + lsda = magnetization_obj%lsda + noncolin = magnetization_obj%noncolin + lspinorb = magnetization_obj%spinorbit + domag = magnetization_obj%do_magnetization + tot_magnetization = magnetization_obj%total + ! + END SUBROUTINE qexsd_copy_magnetization + !----------------------------------------------------------------------- END MODULE qexsd_copy diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 9c8dc37b1b..e939fad1a0 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -40,8 +40,7 @@ MODULE pw_restart_new PRIVATE PUBLIC :: pw_write_schema, pw_write_binaries, pw_read_schema, & read_collected_to_evc - PUBLIC :: readschema_ef, readschema_magnetization, & - readschema_occupations, readschema_brillouin_zone + PUBLIC :: readschema_ef, readschema_occupations, readschema_brillouin_zone ! CONTAINS !------------------------------------------------------------------------ @@ -1004,54 +1003,6 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g ! END SUBROUTINE pw_read_schema ! - !----------------------------------------------------------------------------------------- - SUBROUTINE readschema_magnetization( band_structure_obj, magnetization_obj ) - !--------------------------------------------------------------------------------------- - ! - USE klist, ONLY : two_fermi_energies, nelup, neldw, tot_magnetization - USE ener, ONLY : ef_up, ef_dw - USE lsda_mod, ONLY : nspin, lsda, starting_magnetization - USE noncollin_module, ONLY : noncolin, npol, bfield - USE electrons_base, ONLY : set_nelup_neldw - USE spin_orb, ONLY : lspinorb, domag - USE qes_types_module, ONLY : band_structure_type, magnetization_type - ! - IMPLICIT NONE - ! - TYPE ( band_structure_type ),INTENT(IN) :: band_structure_obj - TYPE ( magnetization_type ) ,INTENT(IN) :: magnetization_obj - REAL(dp) :: nelec_ - ! - lsda = magnetization_obj%lsda - noncolin = magnetization_obj%noncolin - lspinorb = magnetization_obj%spinorbit - domag = magnetization_obj%do_magnetization - ! - IF ( lsda ) THEN - nspin = 2 - npol = 1 - ELSE IF (noncolin ) THEN - nspin = 4 - npol = 2 - ELSE - nspin =1 - npol = 1 - END IF - ! - bfield = 0.d0 - nelec_ = band_structure_obj%nelec - two_fermi_energies = band_structure_obj%two_fermi_energies_ispresent - IF (two_fermi_energies) THEN - ef_up = band_structure_obj%two_fermi_energies(1) - ef_dw = band_structure_obj%two_fermi_energies(2) - IF (TRIM(band_structure_obj%occupations_kind%occupations) == 'fixed') THEN - tot_magnetization = magnetization_obj%total - CALL set_nelup_neldw(tot_magnetization, nelec_, nelup, neldw) - END IF - END IF - ! - END SUBROUTINE readschema_magnetization - !----------------------------------------------------------------------- ! !--------------------------------------------------------------------------- SUBROUTINE readschema_brillouin_zone( band_structure ) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 17180f61f3..d33ab530da 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -103,9 +103,10 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE ions_base, ONLY : nat, nsp, ityp, amass, atm, tau, extfor USE cell_base, ONLY : alat, at, bg, ibrav, celldm, omega USE force_mod, ONLY : force - USE klist, ONLY : nks, nkstot, nelec, wk + USE klist, ONLY : nks, nkstot, nelec, wk, tot_magnetization, & + nelup, neldw USE ener, ONLY : ef, ef_up, ef_dw - USE electrons_base, ONLY : nupdwn + USE electrons_base, ONLY : nupdwn, set_nelup_neldw USE wvfct, ONLY : npwx, nbnd, et, wg USE extfield, ONLY : forcefield, forcegate, tefield, dipfield, & edir, emaxpos, eopreg, eamp, el_dipole, ion_dipole, gate, zgate, & @@ -129,25 +130,24 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, ldftd3, & lxdm, ts_vdw USE Coul_cut_2D, ONLY : do_cutoff_2D - USE noncollin_module,ONLY : noncolin, angle1, angle2 - USE spin_orb, ONLY : domag - USE lsda_mod, ONLY : isk, lsda, starting_magnetization + USE noncollin_module,ONLY : noncolin, npol, angle1, angle2, bfield + USE spin_orb, ONLY : domag, lspinorb + USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization USE realus, ONLY : real_space USE basis, ONLY : natomwfc USE uspp, ONLY : okvan USE paw_variables, ONLY : okpaw ! USE pw_restart_new, ONLY : pw_read_schema, & - readschema_magnetization, & readschema_occupations, readschema_brillouin_zone USE qes_types_module,ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset USE qexsd_copy, ONLY : qexsd_copy_parallel_info, & - qexsd_copy_atomic_species, & + qexsd_copy_algorithmic_info, qexsd_copy_atomic_species, & qexsd_copy_atomic_structure, qexsd_copy_symmetry, & - qexsd_copy_basis_set, qexsd_copy_algorithmic_info,& - qexsd_copy_dft, qexsd_copy_efield, qexsd_copy_band_structure + qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_efield, & + qexsd_copy_band_structure, qexsd_copy_magnetization #if defined(__BEOWULF) USE qes_bcast_module,ONLY : qes_bcast @@ -253,8 +253,23 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! nks = nkstot !! - CALL readschema_magnetization ( output_obj%band_structure, & - output_obj%magnetization ) + !! Magnetization section + CALL qexsd_copy_magnetization ( output_obj%magnetization, lsda, noncolin,& + lspinorb, domag, tot_magnetization ) + ! + bfield = 0.d0 + IF ( lsda ) THEN + nspin = 2 + npol = 1 + ELSE IF (noncolin ) THEN + nspin = 4 + npol = 2 + ELSE + nspin =1 + npol = 1 + END IF + CALL set_nelup_neldw(tot_magnetization, nelec, nelup, neldw) + ! CALL readschema_occupations( output_obj%band_structure ) CALL readschema_brillouin_zone( output_obj%band_structure ) !! Symmetry section From 3bcc0741a95648c6f72fa7d74eb8e9d4287d5235 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Wed, 10 Jul 2019 22:51:24 +0200 Subject: [PATCH 47/95] Change of format in print + no space after "P=" in benchmark => bogus error message in test-suite (xdm). Space added to benchmark. --- test-suite/pw_vdw/benchmark.out.git.inp=xdm.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test-suite/pw_vdw/benchmark.out.git.inp=xdm.in b/test-suite/pw_vdw/benchmark.out.git.inp=xdm.in index 1558946aeb..b10afcf02d 100644 --- a/test-suite/pw_vdw/benchmark.out.git.inp=xdm.in +++ b/test-suite/pw_vdw/benchmark.out.git.inp=xdm.in @@ -246,7 +246,7 @@ Computing stress (Cartesian axis) and pressure - total stress (Ry/bohr**3) (kbar) P=-2730.14 + total stress (Ry/bohr**3) (kbar) P= -2730.14 -0.01813132 -0.00000035 0.00000000 -2667.21 -0.05 0.00 -0.00000035 -0.01813172 0.00000000 -0.05 -2667.27 0.00 0.00000000 0.00000000 -0.01941434 0.00 0.00 -2855.95 From f5a472dd574edc1048f6ff043218336701ee24cd Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Wed, 10 Jul 2019 23:05:19 +0200 Subject: [PATCH 48/95] Possible segmentation fault with hybrid functionals and localization if k-points are used (Fabrizio) --- PW/src/exx.f90 | 16 +++++++++------- PW/src/setup.f90 | 2 +- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/PW/src/exx.f90 b/PW/src/exx.f90 index 50ab51a58d..83de3a6ee2 100644 --- a/PW/src/exx.f90 +++ b/PW/src/exx.f90 @@ -76,7 +76,7 @@ MODULE exx LOGICAL :: exx_fft_initialized = .FALSE. ! G^2 in custom grid REAL(kind=DP), DIMENSION(:), POINTER :: ggt => null() - ! G-vectors in custom grid + ! G-vectors in custom gri REAL(kind=DP), DIMENSION(:,:),POINTER :: gt => null() ! gstart_t=2 if ggt(1)=0, =1 otherwise INTEGER :: gstart_t @@ -463,15 +463,17 @@ SUBROUTINE exxinit(DoLoc) END IF !assign buffer - IF(DoLoc) then + IF(DoLoc) THEN + IF(gamma_only) THEN !$omp parallel do collapse(3) default(shared) firstprivate(npol,nrxxs,nkqs,ibnd_buff_start,ibnd_buff_end) private(ir,ibnd,ikq,ipol) - DO ikq=1,SIZE(locbuff,3) - DO ibnd=1, x_nbnd_occ + DO ikq=1,SIZE(locbuff,3) + DO ibnd=1, x_nbnd_occ DO ir=1,nrxxs*npol - locbuff(ir,ibnd,ikq)=0.0_DP + locbuff(ir,ibnd,ikq)=0.0_DP ENDDO - ENDDO - ENDDO + ENDDO + ENDDO + ENDIF ELSE !$omp parallel do collapse(3) default(shared) firstprivate(npol,nrxxs,nkqs,ibnd_buff_start,ibnd_buff_end) private(ir,ibnd,ikq,ipol) DO ikq=1,SIZE(exxbuff,3) diff --git a/PW/src/setup.f90 b/PW/src/setup.f90 index 94d6211df7..130dfba90d 100644 --- a/PW/src/setup.f90 +++ b/PW/src/setup.f90 @@ -307,7 +307,7 @@ SUBROUTINE setup() .AND. .NOT. tfixed_occ .AND. .NOT. two_fermi_energies ) & CALL errore( 'setup', 'spin-polarized system, specify occupations', 1 ) ! - ! ... setting nelup/neldw + ! ... setting the number of up and down electrons ! call set_nelup_neldw ( tot_magnetization, nelec, nelup, neldw ) ! From 3ccbdc035d3c9294f5e76df28a620c31310eab93 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Thu, 11 Jul 2019 10:56:50 +0200 Subject: [PATCH 49/95] Avoid bogus error in automated tests due to warning. Note the FIXME. --- PW/src/read_file_new.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index d33ab530da..3e9342b385 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -261,6 +261,9 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) IF ( lsda ) THEN nspin = 2 npol = 1 + ! FIXME: next line makes sense only for fixed occupations + ! FIXME: is this really needed? do we use nelup and neldw? + CALL set_nelup_neldw(tot_magnetization, nelec, nelup, neldw) ELSE IF (noncolin ) THEN nspin = 4 npol = 2 @@ -268,7 +271,6 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) nspin =1 npol = 1 END IF - CALL set_nelup_neldw(tot_magnetization, nelec, nelup, neldw) ! CALL readschema_occupations( output_obj%band_structure ) CALL readschema_brillouin_zone( output_obj%band_structure ) From 289dae005731d0a3400f57ded423429200643813 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Thu, 11 Jul 2019 13:03:48 +0200 Subject: [PATCH 50/95] New-style array passed as old-style was giving a segfault on Intel 12: converted new routine to new style arrays --- Modules/xc_gga_drivers.f90 | 18 +++++++++--------- PW/src/paw_onecenter.f90 | 10 +++++----- PW/src/stres_gradcorr.f90 | 23 ----------------------- 3 files changed, 14 insertions(+), 37 deletions(-) diff --git a/Modules/xc_gga_drivers.f90 b/Modules/xc_gga_drivers.f90 index ad77bc5d0b..736e3cb038 100644 --- a/Modules/xc_gga_drivers.f90 +++ b/Modules/xc_gga_drivers.f90 @@ -63,23 +63,23 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) !! length of the I/O arrays INTEGER, INTENT(IN) :: ns !! spin dimension for input - REAL(DP), INTENT(IN) :: rho(length,ns) + REAL(DP), INTENT(IN) :: rho(:,:) !! Charge density - REAL(DP), INTENT(IN) :: grho(3,length,ns) + REAL(DP), INTENT(IN) :: grho(:,:,:) !! gradient - REAL(DP), INTENT(OUT) :: ex(length) + REAL(DP), INTENT(OUT) :: ex(:) !! exchange energy - REAL(DP), INTENT(OUT) :: ec(length) + REAL(DP), INTENT(OUT) :: ec(:) !! correlation energy - REAL(DP), INTENT(OUT) :: v1x(length,ns) + REAL(DP), INTENT(OUT) :: v1x(:,:) !! exchange potential (density part) - REAL(DP), INTENT(OUT) :: v2x(length,ns) + REAL(DP), INTENT(OUT) :: v2x(:,:) !! exchange potential (gradient part) - REAL(DP), INTENT(OUT) :: v1c(length,ns) + REAL(DP), INTENT(OUT) :: v1c(:,:) !! correlation potential (density part) - REAL(DP), INTENT(OUT) :: v2c(length,ns) + REAL(DP), INTENT(OUT) :: v2c(:,:) !! correlation (gradient part) - REAL(DP), INTENT(OUT), OPTIONAL :: v2c_ud(length) + REAL(DP), INTENT(OUT), OPTIONAL :: v2c_ud(:) !! correlation ! ! ... local variables diff --git a/PW/src/paw_onecenter.f90 b/PW/src/paw_onecenter.f90 index 8ff8af2ea5..8a75a97991 100644 --- a/PW/src/paw_onecenter.f90 +++ b/PW/src/paw_onecenter.f90 @@ -630,7 +630,7 @@ SUBROUTINE PAW_gcxc_potential(i, rho_lm,rho_core, v_lm, energy) USE atom, ONLY : g => rgrid USE constants, ONLY : sqrtpi, fpi,pi,e2 USE funct, ONLY : igcc_is_lyp - USE xc_gga, ONLY : xc_gcx ! gcxc, gcx_spin, gcc_spin, gcc_spin_more + USE xc_gga, ONLY : xc_gcx USE mp, ONLY : mp_sum ! TYPE(paw_info), INTENT(IN) :: i ! atom's minimal info @@ -659,7 +659,7 @@ SUBROUTINE PAW_gcxc_potential(i, rho_lm,rho_core, v_lm, energy) ! ! !^^^ - REAL(DP), ALLOCATABLE :: arho(:), grad2_v(:) + REAL(DP), ALLOCATABLE :: arho(:,:), grad2_v(:) REAL(DP), ALLOCATABLE :: r_vec(:,:) !, rh(:), zeta(:) !, grhor(:,:), grhoud(:), grh2(:) ! REAL(DP), DIMENSION(i%m,nspin_gga) :: v1x, v2x, v1c, v2c !workspace @@ -740,7 +740,7 @@ SUBROUTINE PAW_gcxc_potential(i, rho_lm,rho_core, v_lm, energy) ! ! GGA case ! - ALLOCATE( arho(i%m), grad2_v(i%m) ) + ALLOCATE( arho(i%m,1), grad2_v(i%m) ) ALLOCATE( gradx(3,i%m,1)) ! !$omp do @@ -751,8 +751,8 @@ SUBROUTINE PAW_gcxc_potential(i, rho_lm,rho_core, v_lm, energy) CALL PAW_gradient(i, ix, rho_lm, rho_rad, rho_core, grad2, grad) ! DO k = 1, i%m - arho(k) = rho_rad(k,1)*g(i%t)%rm2(k) + rho_core(k) - arho(k) = ABS(arho(k)) + arho(k,1) = rho_rad(k,1)*g(i%t)%rm2(k) + rho_core(k) + arho(k,1) = ABS(arho(k,1)) gradx(:,k,1) = grad(k,:,1) ENDDO ! diff --git a/PW/src/stres_gradcorr.f90 b/PW/src/stres_gradcorr.f90 index 3bc4b94f04..ba09a79c26 100644 --- a/PW/src/stres_gradcorr.f90 +++ b/PW/src/stres_gradcorr.f90 @@ -135,29 +135,6 @@ SUBROUTINE stres_gradcorr( rho, rhog, rho_core, rhog_core, kedtau, nspin, & ENDDO ENDDO ! - ! -! DO k = 1, nrxx -! IF ( dft_is_meta() .AND. get_meta() /= 4 .AND. null_v(k) /= 0 ) THEN -! IF ( ABS(rhoaux(k,1))>epsr .AND. grho2(k,1)>epsg ) THEN -! ! -! kedtau(k,1) = kedtau(k,1) / e2 -! CALL tau_xc( rhoaux(k,1), grho2(k,1), kedtau(k,1), sx(k), sc(k), & -! v1x(k,1), v2x(k,1), v3x, v1c(k,1), v2c(k,1), v3c ) -! kedtau(k,1) = kedtau(k,1) * e2 -! ! -! ENDIF -! ENDIF -! ! -! DO l = 1, 3 -! DO m = 1, l -! sigma_gradcorr(l,m) = sigma_gradcorr(l,m) + grho(l,k,1)*grho(m,k,1)* & -! e2 * (v2x(k,1) + v2c(k,1)) -! ENDDO -! ENDDO -! ! -! ENDDO - ! - ! ELSEIF (nspin == 2) THEN ! ! This is the LSDA case From 14f381951b573a83223429a1f4fb6e7eafa04312 Mon Sep 17 00:00:00 2001 From: Giovanni Pizzi Date: Thu, 11 Jul 2019 14:03:41 +0200 Subject: [PATCH 51/95] Adding support for SCDM with spinor wavefunctions Moreover, this adds a few speed improvements and bug fixes: - some `davcio` routines moved out of a loop to read only once the files - using double precision where appropriate - using slow Fourier transform that ends up being faster than FFT since only the values of psi at some pivot points are needed in SCDM The code has been implemented by Jae-Mo Lihm and merged into the Wannier90 code in https://github.com/wannier-developers/wannier90/pull/277 Co-Authored-By: Jae-Mo Lihm --- PP/src/pw2wannier90.f90 | 486 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 441 insertions(+), 45 deletions(-) diff --git a/PP/src/pw2wannier90.f90 b/PP/src/pw2wannier90.f90 index fc7d2fc3bd..d8a0f31a57 100644 --- a/PP/src/pw2wannier90.f90 +++ b/PP/src/pw2wannier90.f90 @@ -15,6 +15,7 @@ ! Jonathan Yates and Arash Mostofi ! Takashi Koretsune and Florian Thoele -- noncollinear and USPPs ! Valerio Vitale - Selected columns of density matrix (SCDM) +! Jae-Mo Lihm - SCDM with noncollinear ! ! ! NOTE: old_spinor_proj is still available for compatibility with old @@ -232,8 +233,6 @@ PROGRAM pw2wannier90 ! IF (noncolin.and.gamma_only) CALL errore('pw2wannier90',& 'Non-collinear and gamma_only not implemented',1) - IF (noncolin.and.scdm_proj) CALL errore('pw2wannier90',& - 'Non-collinear and SCDM not implemented',1) IF (gamma_only.and.scdm_proj) CALL errore('pw2wannier90',& 'Gamma_only and SCDM not implemented',1) IF (scdm_proj) then @@ -305,7 +304,11 @@ PROGRAM pw2wannier90 WRITE(stdout,*) ' *** Compute A with SCDM-k' WRITE(stdout,*) ' --------------------------' WRITE(stdout,*) - CALL compute_amn_with_scdm + if (noncolin) then + CALL compute_amn_with_scdm_spinor + else + CALL compute_amn_with_scdm + end if ELSE WRITE(stdout,*) ' --------------------------' WRITE(stdout,*) ' *** Compute A projections' @@ -3268,13 +3271,14 @@ SUBROUTINE compute_amn_with_scdm USE io_files, ONLY : nwordwfc, iunwfc USE wannier USE klist, ONLY : nkstot, xk, ngk, igk_k - USE gvect, ONLY : g, ngm + USE gvect, ONLY : g, ngm, mill USE fft_base, ONLY : dffts !vv: unk for the SCDM-k algorithm USE scatter_mod, ONLY : gather_grid USE fft_interfaces, ONLY : invfft !vv: inverse fft transform for computing the unk's on a grid USE noncollin_module,ONLY : noncolin, npol - USE mp, ONLY : mp_bcast, mp_barrier + USE mp, ONLY : mp_bcast, mp_barrier, mp_sum USE mp_world, ONLY : world_comm + USE mp_pools, ONLY : intra_pool_comm USE cell_base, ONLY : at USE ions_base, ONLY : ntyp => nsp, tau USE uspp_param, ONLY : upf @@ -3284,12 +3288,15 @@ SUBROUTINE compute_amn_with_scdm INTEGER, EXTERNAL :: find_free_unit COMPLEX(DP), ALLOCATABLE :: phase(:), nowfc1(:,:), nowfc(:,:), psi_gamma(:,:), & qr_tau(:), cwork(:), cwork2(:), Umat(:,:), VTmat(:,:), Amat(:,:) ! vv: complex arrays for the SVD factorization + COMPLEX(DP), ALLOCATABLE :: phase_g(:,:) ! jml REAL(DP), ALLOCATABLE :: focc(:), rwork(:), rwork2(:), singval(:), rpos(:,:), cpos(:,:) ! vv: Real array for the QR factorization and SVD INTEGER, ALLOCATABLE :: piv(:) ! vv: Pivot array in the QR factorization COMPLEX(DP) :: tmp_cwork(2) - REAL(DP):: ddot, sumk, norm_psi, f_gamma + COMPLEX(DP) :: nowfc_tmp ! jml + REAL(DP):: ddot, sumk, norm_psi, f_gamma, tpi_r_dot_g INTEGER :: ik, npw, ibnd, iw, ikevc, nrtot, ipt, info, lcwork, locibnd, & - jpt,kpt,lpt, ib, istart, gamma_idx, minmn, minmn2, maxmn2, numbands, nbtot + jpt,kpt,lpt, ib, istart, gamma_idx, minmn, minmn2, maxmn2, numbands, nbtot, & + ig, ig_local ! jml CHARACTER (len=9) :: cdate,ctime CHARACTER (len=60) :: header LOGICAL :: any_uspp, found_gamma @@ -3314,11 +3321,6 @@ SUBROUTINE compute_amn_with_scdm any_uspp =any (upf(1:ntyp)%tvanp) - ! vv: Error for using SCDM with non-collinear spin calculations - IF (noncolin) THEN - call errore('pw2wannier90','The SCDM method is not compatible with non-collinear spin yet.',1) - ENDIF - ! vv: Error for using SCDM with Ultrasoft pseudopotentials !IF (any_uspp) THEN ! call errore('pw2wannier90','The SCDM method does not work with Ultrasoft pseudopotential yet.',1) @@ -3403,6 +3405,7 @@ SUBROUTINE compute_amn_with_scdm f_gamma = 0.0_DP ik = gamma_idx locibnd = 0 + CALL davcio (evc, 2*nwordwfc, iunwfc, ik, -1 ) DO ibnd=1,nbtot IF(excluded_band(ibnd)) CYCLE locibnd = locibnd + 1 @@ -3417,7 +3420,6 @@ SUBROUTINE compute_amn_with_scdm ELSE call errore('compute_amn','scdm_entanglement value not recognized.',1) END IF - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, -1 ) npw = ngk(ik) ! vv: Compute unk's on a real grid (the fft grid) psic(:) = (0.D0,0.D0) @@ -3471,9 +3473,9 @@ SUBROUTINE compute_amn_with_scdm DO jpt = 0,dffts%nr2-1 DO ipt = 0,dffts%nr1-1 lpt = lpt + 1 - rpos(lpt,1) = REAL(ipt)/dffts%nr1 - rpos(lpt,2) = REAL(jpt)/dffts%nr2 - rpos(lpt,3) = REAL(kpt)/dffts%nr3 + rpos(lpt,1) = REAL(ipt, DP) / REAL(dffts%nr1, DP) + rpos(lpt,2) = REAL(jpt, DP) / REAL(dffts%nr2, DP) + rpos(lpt,3) = REAL(kpt, DP) / REAL(dffts%nr3, DP) ENDDO ENDDO ENDDO @@ -3487,12 +3489,11 @@ SUBROUTINE compute_amn_with_scdm IF( MOD(ik,10) == 0 ) WRITE (stdout,*) FLUSH(stdout) ikevc = ik + ikstart - 1 -! if(noncolin) then -! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 ) -! else -! end if ! vv: SCDM method for generating the Amn matrix + ! jml: calculate of psi_nk at pivot points using slow FT + ! This is faster than using invfft because the number of pivot + ! points is much smaller than the number of FFT grid points. phase(:) = (0.0_DP,0.0_DP) nowfc1(:,:) = (0.0_DP,0.0_DP) nowfc(:,:) = (0.0_DP,0.0_DP) @@ -3501,7 +3502,27 @@ SUBROUTINE compute_amn_with_scdm Amat(:,:) = (0.0_DP,0.0_DP) singval(:) = 0.0_DP rwork2(:) = 0.0_DP + + ! jml: calculate phase factors before the loop over bands + npw = ngk(ik) + ALLOCATE(phase_g(npw, n_wannier)) + DO iw = 1, n_wannier + phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + & + &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),& + &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + & + &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1))) + + DO ig_local = 1, npw + ig = igk_k(ig_local,ik) + tpi_r_dot_g = 2.0_DP * pi * ( cpos(iw,1) * REAL(mill(1,ig), DP) & + & + cpos(iw,2) * REAL(mill(2,ig), DP) & + & + cpos(iw,3) * REAL(mill(3,ig), DP) ) + phase_g(ig_local, iw) = cmplx(COS(tpi_r_dot_g), SIN(tpi_r_dot_g), kind=DP) + END DO + END DO + locibnd = 0 + CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 ) ! vv: Generate the occupation numbers matrix according to scdm_entanglement DO ibnd=1,nbtot IF (excluded_band(ibnd)) CYCLE @@ -3516,35 +3537,404 @@ SUBROUTINE compute_amn_with_scdm ELSE call errore('compute_amn','scdm_entanglement value not recognized.',1) END IF - CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 ) - npw = ngk(ik) - psic(:) = (0.D0,0.D0) - psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd) - CALL invfft ('Wave', psic, dffts) -#if defined(__MPI) - CALL gather_grid(dffts,psic,psic_all) - norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP)) - psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi - DO iw = 1,n_wannier - phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + & - &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),& - &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + & - &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1))) - nowfc(iw,locibnd) = phase(iw)*psic_all(piv(iw))*focc(locibnd) + + norm_psi = REAL(SUM( evc(1:npw, ibnd) * CONJG(evc(1:npw, ibnd)) )) + CALL mp_sum(norm_psi, intra_pool_comm) + norm_psi = SQRT(norm_psi) + + ! jml: nowfc = sum_G (psi(G) * exp(i*G*r)) * focc * phase(iw) / norm_psi + DO iw = 1, n_wannier + nowfc_tmp = SUM( evc(1:npw, ibnd) * phase_g(1:npw, iw) ) + nowfc(iw,locibnd) = nowfc_tmp * phase(iw) * focc(locibnd) / norm_psi ENDDO + + ENDDO + CALL mp_sum(nowfc, intra_pool_comm) ! jml + DEALLOCATE(phase_g) ! jml + + CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,& + &singval,Umat,numbands,VTmat,n_wannier,tmp_cwork,-1,rwork2,info) + lcwork = AINT(REAL(tmp_cwork(1))) + tmp_cwork(:) = (0.0_DP,0.0_DP) + ALLOCATE(cwork(lcwork)) +#if defined(__MPI) + IF(ionode) THEN + ! vv: SVD to generate orthogonal projections + CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,& + &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info) + IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1) + ENDIF + CALL mp_bcast(Umat,ionode_id,world_comm) + CALL mp_bcast(VTmat,ionode_id,world_comm) #else - norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP)) - psic(1:nrtot) = psic(1:nrtot)/ norm_psi - DO iw = 1,n_wannier - phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + & - &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),& - &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + & - &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1))) - nowfc(iw,locibnd) = phase(iw)*psic(piv(iw))*focc(locibnd) + ! vv: SVD to generate orthogonal projections + CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,& + &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info) + IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1) +#endif + DEALLOCATE(cwork) + Amat = MATMUL(Umat,VTmat) + DO iw = 1,n_wannier + locibnd = 0 + DO ibnd = 1,nbtot + IF (excluded_band(ibnd)) CYCLE + locibnd = locibnd + 1 + IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') locibnd, iw, ik, REAL(Amat(locibnd,iw)), AIMAG(Amat(locibnd,iw)) ENDDO + ENDDO + ENDDO ! k-points + + ! vv: Deallocate all the variables for the SCDM method + DEALLOCATE(kpt_latt) + DEALLOCATE(psi_gamma) + DEALLOCATE(nowfc) + DEALLOCATE(nowfc1) + DEALLOCATE(focc) + DEALLOCATE(piv) + DEALLOCATE(qr_tau) + DEALLOCATE(rwork) + DEALLOCATE(rwork2) + DEALLOCATE(rpos) + DEALLOCATE(cpos) + DEALLOCATE(Umat) + DEALLOCATE(VTmat) + DEALLOCATE(Amat) + DEALLOCATE(singval) + +#if defined(__MPI) + DEALLOCATE( psic_all ) #endif + + IF (ionode .and. wan_mode=='standalone') CLOSE (iun_amn) + WRITE(stdout,'(/)') + WRITE(stdout,*) ' AMN calculated' + CALL stop_clock( 'compute_amn' ) + + RETURN +END SUBROUTINE compute_amn_with_scdm + + +SUBROUTINE compute_amn_with_scdm_spinor + ! + ! jml: scdm for noncollinear case + ! + USE constants, ONLY : rytoev, pi + USE io_global, ONLY : stdout, ionode, ionode_id + USE wvfct, ONLY : nbnd, et, npwx + USE gvecw, ONLY : gcutw + USE control_flags, ONLY : gamma_only + USE wavefunctions, ONLY : evc, psic_nc + USE io_files, ONLY : nwordwfc, iunwfc + USE wannier + USE klist, ONLY : nkstot, xk, ngk, igk_k + USE gvect, ONLY : g, ngm, mill + USE fft_base, ONLY : dffts !vv: unk for the SCDM-k algorithm + USE scatter_mod, ONLY : gather_grid + USE fft_interfaces, ONLY : invfft !vv: inverse fft transform for computing the unk's on a grid + USE noncollin_module,ONLY : noncolin, npol + USE mp, ONLY : mp_bcast, mp_barrier, mp_sum + USE mp_world, ONLY : world_comm + USE mp_pools, ONLY : intra_pool_comm + USE cell_base, ONLY : at + USE ions_base, ONLY : ntyp => nsp, tau + USE uspp_param, ONLY : upf + + IMPLICIT NONE + + INTEGER, EXTERNAL :: find_free_unit + COMPLEX(DP), ALLOCATABLE :: phase(:), nowfc1(:,:), nowfc(:,:), psi_gamma(:,:), & + qr_tau(:), cwork(:), cwork2(:), Umat(:,:), VTmat(:,:), Amat(:,:) ! vv: complex arrays for the SVD factorization + COMPLEX(DP), ALLOCATABLE :: phase_g(:,:) ! jml + REAL(DP), ALLOCATABLE :: focc(:), rwork(:), rwork2(:), singval(:), rpos(:,:), cpos(:,:) ! vv: Real array for the QR factorization and SVD + INTEGER, ALLOCATABLE :: piv(:) ! vv: Pivot array in the QR factorization + INTEGER, ALLOCATABLE :: piv_pos(:), piv_spin(:) ! jml: position and spin index of piv + COMPLEX(DP) :: tmp_cwork(2) + COMPLEX(DP) :: nowfc_tmp ! jml + REAL(DP):: ddot, sumk, norm_psi, f_gamma, tpi_r_dot_g + INTEGER :: ik, npw, ibnd, iw, ikevc, nrtot, ipt, info, lcwork, locibnd, & + jpt,kpt,lpt, ib, istart, gamma_idx, minmn, minmn2, maxmn2, numbands, nbtot, & + ig, ig_local, count_piv_spin, ispin ! jml + CHARACTER (len=9) :: cdate,ctime + CHARACTER (len=60) :: header + LOGICAL :: any_uspp, found_gamma + +#if defined(__MPI) + INTEGER :: nxxs + COMPLEX(DP),ALLOCATABLE :: psic_all(:,:) + nxxs = dffts%nr1x * dffts%nr2x * dffts%nr3x + ALLOCATE(psic_all(nxxs, 2) ) +#endif + + ! vv: Write info about SCDM in output + IF (TRIM(scdm_entanglement) == 'isolated') THEN + WRITE(stdout,'(1x,a,a/)') 'Case : ',trim(scdm_entanglement) + ELSEIF (TRIM(scdm_entanglement) == 'erfc' .OR. & + TRIM(scdm_entanglement) == 'gaussian') THEN + WRITE(stdout,'(1x,a,a)') 'Case : ',trim(scdm_entanglement) + WRITE(stdout,'(1x,a,f10.3,a/,1x,a,f10.3,a/)') 'mu = ', scdm_mu, ' eV', 'sigma =', scdm_sigma, ' eV' + ENDIF + + CALL start_clock( 'compute_amn' ) + + any_uspp =any (upf(1:ntyp)%tvanp) + + ! vv: Error for using SCDM with Ultrasoft pseudopotentials + !IF (any_uspp) THEN + ! call errore('pw2wannier90','The SCDM method does not work with Ultrasoft pseudopotential yet.',1) + !ENDIF + + ! vv: Error for using SCDM with gamma_only + IF (gamma_only) THEN + call errore('pw2wannier90','The SCDM method does not work with gamma_only calculations.',1) + ENDIF + ! vv: Allocate all the variables for the SCDM method: + ! 1)For the QR decomposition + ! 2)For the unk's on the real grid + ! 3)For the SVD + IF(TRIM(scdm_entanglement) == 'isolated') THEN + numbands=n_wannier + nbtot=n_wannier + nexband + ELSE + numbands=nbnd-nexband + nbtot=nbnd + ENDIF + nrtot = dffts%nr1*dffts%nr2*dffts%nr3 + info = 0 + minmn = MIN(numbands,nrtot*2) ! jml: spinor + ALLOCATE(qr_tau(2*minmn)) + ALLOCATE(piv(nrtot*2)) ! jml: spinor + ALLOCATE(piv_pos(n_wannier)) ! jml: spinor + ALLOCATE(piv_spin(n_wannier)) ! jml: spinor + piv(:) = 0 + ALLOCATE(rwork(2*nrtot*2)) ! jml: spinor + rwork(:) = 0.0_DP + + ALLOCATE(kpt_latt(3,iknum)) + ALLOCATE(nowfc1(n_wannier,numbands)) + ALLOCATE(nowfc(n_wannier,numbands)) + ALLOCATE(psi_gamma(nrtot*2,numbands)) ! jml: spinor + ALLOCATE(focc(numbands)) + minmn2 = MIN(numbands,n_wannier) + maxmn2 = MAX(numbands,n_wannier) + ALLOCATE(rwork2(5*minmn2)) + + ALLOCATE(rpos(nrtot,3)) ! jml: spinor + ALLOCATE(cpos(n_wannier,3)) + ALLOCATE(phase(n_wannier)) + ALLOCATE(singval(n_wannier)) + ALLOCATE(Umat(numbands,n_wannier)) + ALLOCATE(VTmat(n_wannier,n_wannier)) + ALLOCATE(Amat(numbands,n_wannier)) + + IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum)) + + IF (wan_mode=='standalone') THEN + iun_amn = find_free_unit() + IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted') + ENDIF + + WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum + ! + IF (wan_mode=='standalone') THEN + CALL date_and_tim( cdate, ctime ) + header='Created on '//cdate//' at '//ctime//' with SCDM ' + IF (ionode) THEN + WRITE (iun_amn,*) header + WRITE (iun_amn,'(3i8,xxx,2f10.6)') numbands, iknum, n_wannier, scdm_mu, scdm_sigma + ENDIF + ENDIF + + !vv: Find Gamma-point index in the list of k-vectors + ik = 0 + gamma_idx = 1 + sumk = -1.0_DP + found_gamma = .false. + kpt_latt(:,1:iknum)=xk(:,1:iknum) + CALL cryst_to_cart(iknum,kpt_latt,at,-1) + DO WHILE(sumk/=0.0_DP .and. ik < iknum) + ik = ik + 1 + sumk = ABS(kpt_latt(1,ik)**2 + kpt_latt(2,ik)**2 + kpt_latt(3,ik)**2) + IF (sumk==0.0_DP) THEN + found_gamma = .true. + gamma_idx = ik + ENDIF + END DO + IF (.not. found_gamma) call errore('compute_amn','No Gamma point found.',1) + + f_gamma = 0.0_DP + ik = gamma_idx + locibnd = 0 + CALL davcio (evc, 2*nwordwfc, iunwfc, ik, -1 ) + DO ibnd=1,nbtot + IF(excluded_band(ibnd)) CYCLE + locibnd = locibnd + 1 + ! check locibnd <= numbands + IF (locibnd > numbands) call errore('compute_amn','Something wrong with the number of bands. Check exclude_bands.') + IF(TRIM(scdm_entanglement) == 'isolated') THEN + f_gamma = 1.0_DP + ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN + f_gamma = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma) + ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN + f_gamma = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2)) + ELSE + call errore('compute_amn','scdm_entanglement value not recognized.',1) + END IF + npw = ngk(ik) + ! vv: Compute unk's on a real grid (the fft grid) + psic_nc(:,:) = (0.D0,0.D0) + psic_nc(dffts%nl (igk_k (1:npw,ik) ), 1) = evc (1:npw,ibnd) + psic_nc(dffts%nl (igk_k (1:npw,ik) ), 2) = evc (1+npwx:npw+npwx,ibnd) + CALL invfft ('Wave', psic_nc(:,1), dffts) + CALL invfft ('Wave', psic_nc(:,2), dffts) + +#if defined(__MPI) + CALL gather_grid(dffts, psic_nc(:,1), psic_all(:,1)) + CALL gather_grid(dffts, psic_nc(:,2), psic_all(:,2)) + norm_psi = sqrt( real(sum(psic_all(1:nrtot, 1)*conjg(psic_all(1:nrtot, 1))),kind=DP) & + +real(sum(psic_all(1:nrtot, 2)*conjg(psic_all(1:nrtot, 2))),kind=DP) ) + ! vv: Gamma only + ! vv: Build Psi_k = Unk * focc + psi_gamma(1:nrtot, locibnd) = psic_all(1:nrtot, 1) * f_gamma / norm_psi + psi_gamma(1+nrtot:2*nrtot,locibnd) = psic_all(1:nrtot, 2) * f_gamma / norm_psi +#else + norm_psi = sqrt( real(sum(psic_nc(1:nrtot, 1)*conjg(psic_nc(1:nrtot, 1))),kind=DP) & + +real(sum(psic_nc(1:nrtot, 2)*conjg(psic_nc(1:nrtot, 2))),kind=DP) ) + psi_gamma(1:nrtot, locibnd) = psic_nc(1:nrtot, 1) * f_gamma / norm_psi + psi_gamma(1+nrtot:2*nrtot,locibnd) = psic_nc(1:nrtot, 2) * f_gamma / norm_psi +#endif + ENDDO + + ! vv: Perform QR factorization with pivoting on Psi_Gamma + ! vv: Preliminary call to define optimal values for lwork and cwork size + CALL ZGEQP3(numbands,nrtot*2,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,tmp_cwork,-1,rwork,info) + IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1) + lcwork = AINT(REAL(tmp_cwork(1))) + tmp_cwork(:) = (0.0_DP,0.0_DP) + piv(:) = 0 + rwork(:) = 0.0_DP + ALLOCATE(cwork(lcwork)) + cwork(:) = (0.0_DP,0.0_DP) +#if defined(__MPI) + IF(ionode) THEN + CALL ZGEQP3(numbands,nrtot*2,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info) + IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1) + ENDIF + CALL mp_bcast(piv,ionode_id,world_comm) +#else + ! vv: Perform QR factorization with pivoting on Psi_Gamma + CALL ZGEQP3(numbands,nrtot*2,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info) + IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1) +#endif + DEALLOCATE(cwork) + tmp_cwork(:) = (0.0_DP,0.0_DP) + + ! jml: calculate position and spin part of piv + count_piv_spin = 0 + DO iw = 1, n_wannier + IF (piv(iw) .le. nrtot) then + piv_pos(iw) = piv(iw) + piv_spin(iw) = 1 + count_piv_spin = count_piv_spin + 1 + else + piv_pos(iw) = piv(iw) - nrtot + piv_spin(iw) = 2 + end if + END DO + WRITE(stdout, '(a,I5)') " Number of pivot points with spin up : ", count_piv_spin + WRITE(stdout, '(a,I5)') " Number of pivot points with spin down: ", n_wannier - count_piv_spin + + ! vv: Compute the points + lpt = 0 + rpos(:,:) = 0.0_DP + cpos(:,:) = 0.0_DP + DO kpt = 0,dffts%nr3-1 + DO jpt = 0,dffts%nr2-1 + DO ipt = 0,dffts%nr1-1 + lpt = lpt + 1 + rpos(lpt,1) = DBLE(ipt)/DBLE(dffts%nr1) + rpos(lpt,2) = DBLE(jpt)/DBLE(dffts%nr2) + rpos(lpt,3) = DBLE(kpt)/DBLE(dffts%nr3) + ENDDO ENDDO + ENDDO + DO iw=1,n_wannier + cpos(iw,:) = rpos(piv_pos(iw),:) + cpos(iw,:) = cpos(iw,:) - ANINT(cpos(iw,:)) + ENDDO + + DO ik=1,iknum + WRITE (stdout,'(i8)',advance='no') ik + IF( MOD(ik,10) == 0 ) WRITE (stdout,*) + FLUSH(stdout) + ikevc = ik + ikstart - 1 + + ! vv: SCDM method for generating the Amn matrix + ! jml: calculate of psi_nk at pivot points using slow FT + ! This is faster than using invfft because the number of pivot + ! points is much smaller than the number of FFT grid points. + phase(:) = (0.0_DP,0.0_DP) + nowfc1(:,:) = (0.0_DP,0.0_DP) + nowfc(:,:) = (0.0_DP,0.0_DP) + Umat(:,:) = (0.0_DP,0.0_DP) + VTmat(:,:) = (0.0_DP,0.0_DP) + Amat(:,:) = (0.0_DP,0.0_DP) + singval(:) = 0.0_DP + rwork2(:) = 0.0_DP + + ! jml: calculate phase factors before the loop over bands + npw = ngk(ik) + ALLOCATE(phase_g(npw, n_wannier)) + DO iw = 1, n_wannier + phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + & + &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),& + &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + & + &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1))) + + DO ig_local = 1, npw + ig = igk_k(ig_local,ik) + tpi_r_dot_g = 2.0_DP * pi * ( cpos(iw,1) * REAL(mill(1,ig), DP) & + & + cpos(iw,2) * REAL(mill(2,ig), DP) & + & + cpos(iw,3) * REAL(mill(3,ig), DP) ) + phase_g(ig_local, iw) = cmplx(COS(tpi_r_dot_g), SIN(tpi_r_dot_g), kind=DP) + END DO + END DO + + locibnd = 0 + CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 ) + DO ibnd=1,nbtot + IF (excluded_band(ibnd)) CYCLE + locibnd = locibnd + 1 + ! vv: Define the occupation numbers matrix according to scdm_entanglement + IF(TRIM(scdm_entanglement) == 'isolated') THEN + focc(locibnd) = 1.0_DP + ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN + focc(locibnd) = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma) + ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN + focc(locibnd) = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2)) + ELSE + call errore('compute_amn','scdm_entanglement value not recognized.',1) + END IF + + norm_psi= REAL(SUM( evc(1:npw,ibnd) * CONJG(evc(1:npw,ibnd)) )) & + + REAL(SUM( evc(1+npwx:npw+npwx,ibnd) * CONJG(evc(1+npwx:npw+npwx,ibnd)) )) + CALL mp_sum(norm_psi, intra_pool_comm) + norm_psi= sqrt(norm_psi) + + ! jml: nowfc = sum_G (psi(G) * exp(i*G*r)) * focc * phase(iw) / norm_psi + DO iw = 1, n_wannier + if (piv_spin(iw) == 1) then ! spin up + nowfc_tmp = sum( evc(1:npw, ibnd) * phase_g(1:npw, iw) ) + else ! spin down + nowfc_tmp = sum( evc(1+npwx:npw+npwx, ibnd) * phase_g(1:npw, iw) ) + end if + + nowfc(iw, locibnd) = nowfc_tmp * phase(iw) * focc(locibnd) / norm_psi + ENDDO + + END DO ! ibnd + CALL mp_sum(nowfc, intra_pool_comm) ! jml + DEALLOCATE(phase_g) ! jml CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,& &singval,Umat,numbands,VTmat,n_wannier,tmp_cwork,-1,rwork2,info) @@ -3567,8 +3957,10 @@ SUBROUTINE compute_amn_with_scdm IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1) #endif DEALLOCATE(cwork) - + Amat = MATMUL(Umat,VTmat) + + CALL start_clock( 'scdm_write' ) DO iw = 1,n_wannier locibnd = 0 DO ibnd = 1,nbtot @@ -3577,6 +3969,7 @@ SUBROUTINE compute_amn_with_scdm IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') locibnd, iw, ik, REAL(Amat(locibnd,iw)), AIMAG(Amat(locibnd,iw)) ENDDO ENDDO + CALL stop_clock( 'scdm_write' ) ENDDO ! k-points ! vv: Deallocate all the variables for the SCDM method @@ -3586,6 +3979,8 @@ SUBROUTINE compute_amn_with_scdm DEALLOCATE(nowfc1) DEALLOCATE(focc) DEALLOCATE(piv) + DEALLOCATE(piv_pos) + DEALLOCATE(piv_spin) DEALLOCATE(qr_tau) DEALLOCATE(rwork) DEALLOCATE(rwork2) @@ -3606,7 +4001,8 @@ SUBROUTINE compute_amn_with_scdm CALL stop_clock( 'compute_amn' ) RETURN -END SUBROUTINE compute_amn_with_scdm +END SUBROUTINE compute_amn_with_scdm_spinor + subroutine orient_gf_spinor(npw) use constants, only: eps6 From 16757dd67466463713b354091a9ae2690909c1f7 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Thu, 11 Jul 2019 14:28:32 +0200 Subject: [PATCH 52/95] More I/O cleanup k-points are read together with weights --- CPV/src/cp_restart_new.f90 | 4 ++-- Modules/qexsd_copy.f90 | 7 +++++-- PW/src/pw_restart_new.f90 | 22 +--------------------- PW/src/read_file_new.f90 | 8 ++++---- 4 files changed, 12 insertions(+), 29 deletions(-) diff --git a/CPV/src/cp_restart_new.f90 b/CPV/src/cp_restart_new.f90 index 7a6f6e9f36..b77eb5825f 100644 --- a/CPV/src/cp_restart_new.f90 +++ b/CPV/src/cp_restart_new.f90 @@ -806,8 +806,8 @@ SUBROUTINE cp_readfile( ndr, ascii, nfi, simtime, acc, nk, xk, & nbnd_ = nupdwn(1) ALLOCATE( occ_(nbnd_, nspin), et_(nbnd_, nspin) ) CALL qexsd_copy_band_structure( output_obj%band_structure, lsda_, & - nk_, isk_, natomwfc, nbnd, nbnd_up, nbnd_dw, nelec_, wk_, & - occ_, ef, ef_up, ef_dw, et_ ) + nk_, isk_, natomwfc, nbnd, nbnd_up, nbnd_dw, nelec_, xk, & + wk_, occ_, ef, ef_up, ef_dw, et_ ) ! FIXME: in the call, the same array is passed as both occ0 and occm! DO iss = 1, nspin ib = iupdwn(iss) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 0eaa688658..2dc7bb1f9d 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -445,7 +445,7 @@ END SUBROUTINE qexsd_copy_dft ! !------------------------------------------------------------------------ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & - isk, natomwfc, nbnd, nbnd_up, nbnd_dw, nelec, wk, wg, & + isk, natomwfc, nbnd, nbnd_up, nbnd_dw, nelec, xk, wk, wg, & ef, ef_up, ef_dw, et ) !------------------------------------------------------------------------ ! @@ -458,7 +458,7 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & LOGICAL, INTENT(out) :: lsda INTEGER, INTENT(out) :: nkstot, natomwfc, nbnd, nbnd_up, nbnd_dw, & isk(:) - REAL(dp), INTENT(out):: nelec, ef, ef_up, ef_dw, wk(:) + REAL(dp), INTENT(out):: nelec, ef, ef_up, ef_dw, xk(:,:), wk(:) REAL(dp), INTENT(inout), ALLOCATABLE :: wg(:,:), et(:,:) ! INTEGER :: ik @@ -526,6 +526,8 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & ! DO ik =1, band_struct_obj%ndim_ks_energies IF ( band_struct_obj%lsda) THEN + xk(:,ik) = band_struct_obj%ks_energies(ik)%k_point%k_point(:) + xk(:,ik + band_struct_obj%ndim_ks_energies) = xk(:,ik) wk(ik) = band_struct_obj%ks_energies(ik)%k_point%weight wk(ik + band_struct_obj%ndim_ks_energies ) = wk(ik) et(1:nbnd_up,ik) = band_struct_obj%ks_energies(ik)%eigenvalues%vector(1:nbnd_up) @@ -536,6 +538,7 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & wg(1:nbnd_dw,ik+band_struct_obj%ndim_ks_energies) = & band_struct_obj%ks_energies(ik)%occupations%vector(nbnd_up+1:nbnd_up+nbnd_dw)*wk(ik) ELSE + xk(:,ik) = band_struct_obj%ks_energies(ik)%k_point%k_point(:) wk(ik) = band_struct_obj%ks_energies(ik)%k_point%weight et (1:nbnd,ik) = band_struct_obj%ks_energies(ik)%eigenvalues%vector(1:nbnd) wg (1:nbnd,ik) = band_struct_obj%ks_energies(ik)%occupations%vector(1:nbnd)*wk(ik) diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index e939fad1a0..8c334f58c1 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -1008,8 +1008,6 @@ END SUBROUTINE pw_read_schema SUBROUTINE readschema_brillouin_zone( band_structure ) !--------------------------------------------------------------------------- ! - USE lsda_mod, ONLY : lsda, isk - USE klist, ONLY : nkstot, xk, wk USE start_k, ONLY : nks_start, xk_start, wk_start, & nk1, nk2, nk3, k1, k2, k3 USE qes_types_module, ONLY : band_structure_type @@ -1017,26 +1015,8 @@ SUBROUTINE readschema_brillouin_zone( band_structure ) IMPLICIT NONE ! TYPE ( band_structure_type ),INTENT(IN) :: band_structure - INTEGER :: ik, isym, nks_ + INTEGER :: ik ! - nks_ = band_structure%nks - nkstot = nks_ - IF ( band_structure%lsda ) nkstot = nkstot * 2 - ! - ! - DO ik = 1, nks_ - xk(:,ik) = band_structure%ks_energies(ik)%k_point%k_point(:) - END DO - !! during lsda computations pw uses, for each k-point in the mesh, a distinct - !! k_point variable for the two spin channels, while in - !! the xml file only one k_point is present - IF ( band_structure%lsda ) THEN - DO ik = 1, nks_ - xk(:,nks_+ik) = band_structure%ks_energies(ik)%k_point%k_point(:) - isk(ik) = 1 - isk(ik+nks_) = 2 - END DO - END IF ! IF ( band_structure%starting_k_points%monkhorst_pack_ispresent ) THEN nks_start = 0 diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 3e9342b385..3a8ce827ce 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -103,8 +103,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE ions_base, ONLY : nat, nsp, ityp, amass, atm, tau, extfor USE cell_base, ONLY : alat, at, bg, ibrav, celldm, omega USE force_mod, ONLY : force - USE klist, ONLY : nks, nkstot, nelec, wk, tot_magnetization, & - nelup, neldw + USE klist, ONLY : nks, nkstot, xk, wk, tot_magnetization, & + nelec, nelup, neldw USE ener, ONLY : ef, ef_up, ef_dw USE electrons_base, ONLY : nupdwn, set_nelup_neldw USE wvfct, ONLY : npwx, nbnd, et, wg @@ -240,8 +240,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) !! Band structure section !! et and wg are allocated inside qexsd_copy_band_structure CALL qexsd_copy_band_structure( output_obj%band_structure, lsda, & - nkstot, isk, natomwfc, nbnd, nupdwn(1), nupdwn(2), nelec, wk, wg, & - ef, ef_up, ef_dw, et ) + nkstot, isk, natomwfc, nbnd, nupdwn(1), nupdwn(2), nelec, xk, & + wk, wg, ef, ef_up, ef_dw, et ) ! convert to Ry ef = ef*e2 ef_up = ef_up*e2 From 2334e9c23a4de70a077d1896133676c0c320d044 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Thu, 11 Jul 2019 17:05:28 +0200 Subject: [PATCH 53/95] Workaround for weird phonon symmetry errors --- PW/src/read_file_new.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 3a8ce827ce..245e44d42f 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -219,6 +219,10 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ecutwfc = ecutwfc*e2 ecutrho = ecutrho*e2 dual = ecutrho/ecutwfc + ! FIXME: next line ensures exact consistency between reciprocal and + ! direct lattice vectors, preventing weird phonon symmetry errors + ! (due to lousy algorithms, extraordinarily sensitive to tiny errors) + CALL recips ( at(1,1), at(1,2), at(1,3), bg(1,1), bg(1,2), bg(1,3) ) !! !! DFT section CALL qexsd_copy_dft ( output_obj%dft, nsp, atm, & From fccb136718c6609087828c50202e273df976206c Mon Sep 17 00:00:00 2001 From: Ronald Cohen Date: Thu, 11 Jul 2019 19:41:40 +0200 Subject: [PATCH 54/95] made format fields larger so that when atoms diffuse long distances the field can hold the positions --- output_tau.f90 | 118 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 118 insertions(+) create mode 100644 output_tau.f90 diff --git a/output_tau.f90 b/output_tau.f90 new file mode 100644 index 0000000000..c6b5057ab1 --- /dev/null +++ b/output_tau.f90 @@ -0,0 +1,118 @@ +! +! Copyright (C) 2003-2009 Quantum ESPRESSO group +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +!---------------------------------------------------------------------------- +SUBROUTINE output_tau( print_lattice, print_final ) + !---------------------------------------------------------------------------- + ! + USE io_global, ONLY : stdout + USE kinds, ONLY : DP + USE constants, ONLY : bohr_radius_angs, AVOGADRO + USE cell_base, ONLY : alat, at, bg, omega, cell_units + USE ions_base, ONLY : nat, tau, ityp, atm, if_pos, tau_format, amass + ! + IMPLICIT NONE + ! + LOGICAL, INTENT(IN) :: print_lattice, print_final + REAL (DP), ALLOCATABLE :: tau_out(:,:) + INTEGER :: na, i, k + ! + ! + ! ... tau in output format + ! + ALLOCATE( tau_out(3,nat) ) + ! + tau_out(:,:) = tau(:,:) + ! + ! ... print cell parameters if required + ! + IF ( print_final ) WRITE( stdout, '("Begin final coordinates")') + IF ( print_lattice ) THEN + ! + WRITE( stdout, '(5x,a,1F12.5," a.u.^3 ( ",1F11.5," Ang^3 )")') & + "new unit-cell volume = ",omega, omega*bohr_radius_angs**3 + WRITE( stdout, '(5x,a,1F12.5," g/cm^3")') & + "density = ", SUM( amass(ityp(1:nat)) )& + /(omega*bohr_radius_angs**3 * 1.d-24)/AVOGADRO + + SELECT CASE (cell_units) + ! + ! ... convert output cell from internally used format + ! ... (alat units) to the same format used in input + ! + CASE( 'alat' ) + WRITE( stdout, '(/"CELL_PARAMETERS (alat=",f12.8,")")') alat + WRITE( stdout, '(3F14.9)') ( ( at(i,k), i = 1, 3), k = 1, 3 ) + CASE( 'bohr' ) + WRITE( stdout, '(/"CELL_PARAMETERS (bohr)")') + WRITE( stdout, '(3F14.9)') ( ( at(i,k) * alat, i = 1, 3), k = 1, 3 ) + CASE( 'angstrom' ) + WRITE( stdout, '(/"CELL_PARAMETERS (angstrom)")') + WRITE( stdout, '(3F14.9)') & + ( ( at(i,k) * alat * bohr_radius_angs, i = 1, 3), k = 1, 3 ) + CASE DEFAULT + WRITE( stdout, '(/"CELL_PARAMETERS (alat=",f12.8,")")') alat + WRITE( stdout, '(3F14.9)') ( ( at(i,k), i = 1, 3), k = 1, 3 ) + END SELECT + ! + END IF + ! + SELECT CASE( tau_format ) + ! + ! ... convert output atomic positions from internally used format + ! ... (a0 units) to the same format used in input + ! + CASE( 'alat' ) + ! + WRITE( stdout, '(/"ATOMIC_POSITIONS (alat)")' ) + ! + CASE( 'bohr' ) + ! + WRITE( stdout, '(/"ATOMIC_POSITIONS (bohr)")' ) + tau_out(:,:) = tau_out(:,:) * alat + ! + CASE( 'crystal' ) + ! + WRITE( stdout, '(/"ATOMIC_POSITIONS (crystal)")' ) + ! + call cryst_to_cart( nat, tau_out, bg, -1 ) + ! + CASE( 'angstrom' ) + ! + WRITE( stdout, '(/"ATOMIC_POSITIONS (angstrom)")' ) + ! + tau_out(:,:) = tau_out(:,:) * alat * bohr_radius_angs + ! + CASE DEFAULT + ! + WRITE( stdout, '(/"ATOMIC_POSITIONS")' ) + ! + END SELECT + ! + DO na = 1, nat + ! + IF ( ALLOCATED( if_pos ) ) THEN + IF ( ANY( if_pos(:,na) == 0 ) ) THEN + WRITE( stdout,'(A3,3X,3F20.10,1X,3i4)') & + atm(ityp(na)), tau_out(:,na), if_pos(:,na) + ELSE + WRITE( stdout,'(A3,3X,3F20.10)') atm(ityp(na)), tau_out(:,na) + END IF + ELSE + WRITE( stdout,'(A3,3X,3F20.10)') atm(ityp(na)), tau_out(:,na) + END IF + ! + END DO + ! + IF ( print_final ) WRITE( stdout, '("End final coordinates")') + WRITE( stdout, '(/)' ) + ! + DEALLOCATE( tau_out ) + ! + RETURN + ! +END SUBROUTINE output_tau From 2207c16db97d37dfa52b40781aaa6ce31dff4f39 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Thu, 11 Jul 2019 22:32:55 +0200 Subject: [PATCH 55/95] More I/O cleanup: starting k-points --- Modules/qexsd_copy.f90 | 54 +++++++++++++++++++++++++++++++++++- PW/src/pw_restart_new.f90 | 58 ++------------------------------------- PW/src/read_file_new.f90 | 12 +++++--- 3 files changed, 64 insertions(+), 60 deletions(-) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 2dc7bb1f9d..f05e759a02 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -23,7 +23,7 @@ MODULE qexsd_copy qexsd_copy_atomic_species, qexsd_copy_atomic_structure, & qexsd_copy_symmetry, qexsd_copy_algorithmic_info, & qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure, & - qexsd_copy_efield, qexsd_copy_magnetization + qexsd_copy_efield, qexsd_copy_magnetization, qexsd_copy_kpoints ! CONTAINS !------------------------------------------------------------------------------- @@ -650,4 +650,56 @@ SUBROUTINE qexsd_copy_magnetization ( magnetization_obj, & ! END SUBROUTINE qexsd_copy_magnetization !----------------------------------------------------------------------- + ! + !--------------------------------------------------------------------------- + SUBROUTINE qexsd_copy_kpoints ( band_struct_obj, nks_start, xk_start,& + wk_start, nk1, nk2, nk3, k1, k2, k3 ) + !--------------------------------------------------------------------------- + ! + USE qes_types_module, ONLY : band_structure_type + ! + IMPLICIT NONE + ! + TYPE ( band_structure_type ),INTENT(IN) :: band_struct_obj + INTEGER, INTENT(out) :: nks_start, nk1, nk2, nk3, k1, k2, k3 + REAL(dp), ALLOCATABLE, INTENT(inout) :: xk_start(:,:), wk_start(:) + ! + INTEGER :: ik + ! + ! + IF ( band_struct_obj%starting_k_points%monkhorst_pack_ispresent ) THEN + nks_start = 0 + nk1 = band_struct_obj%starting_k_points%monkhorst_pack%nk1 + nk2 = band_struct_obj%starting_k_points%monkhorst_pack%nk2 + nk3 = band_struct_obj%starting_k_points%monkhorst_pack%nk3 + k1 = band_struct_obj%starting_k_points%monkhorst_pack%k1 + k2 = band_struct_obj%starting_k_points%monkhorst_pack%k2 + k3 = band_struct_obj%starting_k_points%monkhorst_pack%k3 + ELSE IF (band_struct_obj%starting_k_points%nk_ispresent ) THEN + nks_start = band_struct_obj%starting_k_points%nk + IF ( nks_start > 0 ) THEN + IF ( .NOT. ALLOCATED(xk_start) ) ALLOCATE (xk_start(3,nks_start)) + IF ( .NOT. ALLOCATED(wk_start) ) ALLOCATE (wk_start(nks_start)) + IF ( nks_start == size( band_struct_obj%starting_k_points%k_point ) ) THEN + DO ik =1, nks_start + xk_start(:,ik) = band_struct_obj%starting_k_points%k_point(ik)%k_point(:) + IF ( band_struct_obj%starting_k_points%k_point(ik)%weight_ispresent) THEN + wk_start(ik) = band_struct_obj%starting_k_points%k_point(ik)%weight + ELSE + wk_start(ik) = 0.d0 + END IF + END DO + ELSE + CALL infomsg ( "qexsd_copy_kp: ", & + "actual number of start kpoint not equal to nks_start, set nks_start=0") + nks_start = 0 + END IF + END IF + ELSE + CALL errore ("qexsd_copy_kp: ", & + " no information found for initializing brillouin zone information", 1) + END IF + ! + END SUBROUTINE qexsd_copy_kpoints + ! END MODULE qexsd_copy diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 8c334f58c1..62a17b0df3 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -40,7 +40,7 @@ MODULE pw_restart_new PRIVATE PUBLIC :: pw_write_schema, pw_write_binaries, pw_read_schema, & read_collected_to_evc - PUBLIC :: readschema_ef, readschema_occupations, readschema_brillouin_zone + PUBLIC :: readschema_ef, readschema_occupations ! CONTAINS !------------------------------------------------------------------------ @@ -1003,71 +1003,19 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g ! END SUBROUTINE pw_read_schema ! - ! - !--------------------------------------------------------------------------- - SUBROUTINE readschema_brillouin_zone( band_structure ) - !--------------------------------------------------------------------------- - ! - USE start_k, ONLY : nks_start, xk_start, wk_start, & - nk1, nk2, nk3, k1, k2, k3 - USE qes_types_module, ONLY : band_structure_type - ! - IMPLICIT NONE - ! - TYPE ( band_structure_type ),INTENT(IN) :: band_structure - INTEGER :: ik - ! - ! - IF ( band_structure%starting_k_points%monkhorst_pack_ispresent ) THEN - nks_start = 0 - nk1 = band_structure%starting_k_points%monkhorst_pack%nk1 - nk2 = band_structure%starting_k_points%monkhorst_pack%nk2 - nk3 = band_structure%starting_k_points%monkhorst_pack%nk3 - k1 = band_structure%starting_k_points%monkhorst_pack%k1 - k2 = band_structure%starting_k_points%monkhorst_pack%k2 - k3 = band_structure%starting_k_points%monkhorst_pack%k3 - ELSE IF (band_structure%starting_k_points%nk_ispresent ) THEN - nks_start = band_structure%starting_k_points%nk - IF ( nks_start > 0 ) THEN - IF ( .NOT. ALLOCATED(xk_start) ) ALLOCATE (xk_start(3,nks_start)) - IF ( .NOT. ALLOCATED(wk_start) ) ALLOCATE (wk_start(nks_start)) - IF ( nks_start == size( band_structure%starting_k_points%k_point ) ) THEN - DO ik =1, nks_start - xk_start(:,ik) = band_structure%starting_k_points%k_point(ik)%k_point(:) - IF ( band_structure%starting_k_points%k_point(ik)%weight_ispresent) THEN - wk_start(ik) = band_structure%starting_k_points%k_point(ik)%weight - ELSE - wk_start(ik) = 0.d0 - END IF - END DO - ELSE - CALL infomsg ( "readschema_bz: ", & - "actual number of start kpoint not equal to nks_start, set nks_start=0") - nks_start = 0 - END IF - END IF - ELSE - CALL errore ("readschema_bz: ", & - " no information found for initializing brillouin zone information", 1) - END IF - ! - END SUBROUTINE readschema_brillouin_zone !-------------------------------------------------------------------------------------------------- SUBROUTINE readschema_occupations( band_struct_obj ) !------------------------------------------------------------------------------------------------ ! - USE lsda_mod, ONLY : lsda, nspin - USE fixed_occ, ONLY : tfixed_occ, f_inp USE ktetra, ONLY : ntetra, tetra_type USE klist, ONLY : ltetra, lgauss, ngauss, degauss, smearing - USE wvfct, ONLY : nbnd USE input_parameters, ONLY : input_parameters_occupations => occupations - USE qes_types_module, ONLY : input_type, band_structure_type + USE qes_types_module, ONLY : band_structure_type ! IMPLICIT NONE ! TYPE ( band_structure_type ),INTENT(IN) :: band_struct_obj - INTEGER :: ispin, nk1, nk2, nk3, aux_dim1, aux_dim2 + INTEGER :: nk1, nk2, nk3 ! lgauss = .FALSE. ltetra = .FALSE. diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 245e44d42f..c264ef6415 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -105,6 +105,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE force_mod, ONLY : force USE klist, ONLY : nks, nkstot, xk, wk, tot_magnetization, & nelec, nelup, neldw + USE start_k, ONLY : nks_start, xk_start, wk_start, & + nk1, nk2, nk3, k1, k2, k3 USE ener, ONLY : ef, ef_up, ef_dw USE electrons_base, ONLY : nupdwn, set_nelup_neldw USE wvfct, ONLY : npwx, nbnd, et, wg @@ -139,7 +141,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE paw_variables, ONLY : okpaw ! USE pw_restart_new, ONLY : pw_read_schema, & - readschema_occupations, readschema_brillouin_zone + readschema_occupations USE qes_types_module,ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset @@ -147,8 +149,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) qexsd_copy_algorithmic_info, qexsd_copy_atomic_species, & qexsd_copy_atomic_structure, qexsd_copy_symmetry, & qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_efield, & - qexsd_copy_band_structure, qexsd_copy_magnetization - + qexsd_copy_band_structure, qexsd_copy_magnetization, & + qexsd_copy_kpoints #if defined(__BEOWULF) USE qes_bcast_module,ONLY : qes_bcast USE mp_images, ONLY : intra_image_comm @@ -277,7 +279,9 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) END IF ! CALL readschema_occupations( output_obj%band_structure ) - CALL readschema_brillouin_zone( output_obj%band_structure ) + !! Starting k-òoint information + CALL qexsd_copy_kpoints( output_obj%band_structure, nks_start, & + xk_start, wk_start, nk1, nk2, nk3, k1, k2, k3 ) !! Symmetry section ALLOCATE ( irt(48,nat) ) IF ( lvalid_input ) THEN From 1feb6d54ff3da0c0feac985d3804e0b961952844 Mon Sep 17 00:00:00 2001 From: Ronald Cohen Date: Thu, 11 Jul 2019 22:43:17 +0200 Subject: [PATCH 56/95] made format fields larger so that when atoms diffuse long distances the field can hold the positions --- PW/src/output_tau.f90 | 6 +-- output_tau.f90 | 118 ------------------------------------------ 2 files changed, 3 insertions(+), 121 deletions(-) delete mode 100644 output_tau.f90 diff --git a/PW/src/output_tau.f90 b/PW/src/output_tau.f90 index 006eb31c53..c6b5057ab1 100644 --- a/PW/src/output_tau.f90 +++ b/PW/src/output_tau.f90 @@ -97,13 +97,13 @@ SUBROUTINE output_tau( print_lattice, print_final ) ! IF ( ALLOCATED( if_pos ) ) THEN IF ( ANY( if_pos(:,na) == 0 ) ) THEN - WRITE( stdout,'(A3,3X,3F14.9,1X,3i4)') & + WRITE( stdout,'(A3,3X,3F20.10,1X,3i4)') & atm(ityp(na)), tau_out(:,na), if_pos(:,na) ELSE - WRITE( stdout,'(A3,3X,3F14.9)') atm(ityp(na)), tau_out(:,na) + WRITE( stdout,'(A3,3X,3F20.10)') atm(ityp(na)), tau_out(:,na) END IF ELSE - WRITE( stdout,'(A3,3X,3F14.9)') atm(ityp(na)), tau_out(:,na) + WRITE( stdout,'(A3,3X,3F20.10)') atm(ityp(na)), tau_out(:,na) END IF ! END DO diff --git a/output_tau.f90 b/output_tau.f90 deleted file mode 100644 index c6b5057ab1..0000000000 --- a/output_tau.f90 +++ /dev/null @@ -1,118 +0,0 @@ -! -! Copyright (C) 2003-2009 Quantum ESPRESSO group -! This file is distributed under the terms of the -! GNU General Public License. See the file `License' -! in the root directory of the present distribution, -! or http://www.gnu.org/copyleft/gpl.txt . -! -!---------------------------------------------------------------------------- -SUBROUTINE output_tau( print_lattice, print_final ) - !---------------------------------------------------------------------------- - ! - USE io_global, ONLY : stdout - USE kinds, ONLY : DP - USE constants, ONLY : bohr_radius_angs, AVOGADRO - USE cell_base, ONLY : alat, at, bg, omega, cell_units - USE ions_base, ONLY : nat, tau, ityp, atm, if_pos, tau_format, amass - ! - IMPLICIT NONE - ! - LOGICAL, INTENT(IN) :: print_lattice, print_final - REAL (DP), ALLOCATABLE :: tau_out(:,:) - INTEGER :: na, i, k - ! - ! - ! ... tau in output format - ! - ALLOCATE( tau_out(3,nat) ) - ! - tau_out(:,:) = tau(:,:) - ! - ! ... print cell parameters if required - ! - IF ( print_final ) WRITE( stdout, '("Begin final coordinates")') - IF ( print_lattice ) THEN - ! - WRITE( stdout, '(5x,a,1F12.5," a.u.^3 ( ",1F11.5," Ang^3 )")') & - "new unit-cell volume = ",omega, omega*bohr_radius_angs**3 - WRITE( stdout, '(5x,a,1F12.5," g/cm^3")') & - "density = ", SUM( amass(ityp(1:nat)) )& - /(omega*bohr_radius_angs**3 * 1.d-24)/AVOGADRO - - SELECT CASE (cell_units) - ! - ! ... convert output cell from internally used format - ! ... (alat units) to the same format used in input - ! - CASE( 'alat' ) - WRITE( stdout, '(/"CELL_PARAMETERS (alat=",f12.8,")")') alat - WRITE( stdout, '(3F14.9)') ( ( at(i,k), i = 1, 3), k = 1, 3 ) - CASE( 'bohr' ) - WRITE( stdout, '(/"CELL_PARAMETERS (bohr)")') - WRITE( stdout, '(3F14.9)') ( ( at(i,k) * alat, i = 1, 3), k = 1, 3 ) - CASE( 'angstrom' ) - WRITE( stdout, '(/"CELL_PARAMETERS (angstrom)")') - WRITE( stdout, '(3F14.9)') & - ( ( at(i,k) * alat * bohr_radius_angs, i = 1, 3), k = 1, 3 ) - CASE DEFAULT - WRITE( stdout, '(/"CELL_PARAMETERS (alat=",f12.8,")")') alat - WRITE( stdout, '(3F14.9)') ( ( at(i,k), i = 1, 3), k = 1, 3 ) - END SELECT - ! - END IF - ! - SELECT CASE( tau_format ) - ! - ! ... convert output atomic positions from internally used format - ! ... (a0 units) to the same format used in input - ! - CASE( 'alat' ) - ! - WRITE( stdout, '(/"ATOMIC_POSITIONS (alat)")' ) - ! - CASE( 'bohr' ) - ! - WRITE( stdout, '(/"ATOMIC_POSITIONS (bohr)")' ) - tau_out(:,:) = tau_out(:,:) * alat - ! - CASE( 'crystal' ) - ! - WRITE( stdout, '(/"ATOMIC_POSITIONS (crystal)")' ) - ! - call cryst_to_cart( nat, tau_out, bg, -1 ) - ! - CASE( 'angstrom' ) - ! - WRITE( stdout, '(/"ATOMIC_POSITIONS (angstrom)")' ) - ! - tau_out(:,:) = tau_out(:,:) * alat * bohr_radius_angs - ! - CASE DEFAULT - ! - WRITE( stdout, '(/"ATOMIC_POSITIONS")' ) - ! - END SELECT - ! - DO na = 1, nat - ! - IF ( ALLOCATED( if_pos ) ) THEN - IF ( ANY( if_pos(:,na) == 0 ) ) THEN - WRITE( stdout,'(A3,3X,3F20.10,1X,3i4)') & - atm(ityp(na)), tau_out(:,na), if_pos(:,na) - ELSE - WRITE( stdout,'(A3,3X,3F20.10)') atm(ityp(na)), tau_out(:,na) - END IF - ELSE - WRITE( stdout,'(A3,3X,3F20.10)') atm(ityp(na)), tau_out(:,na) - END IF - ! - END DO - ! - IF ( print_final ) WRITE( stdout, '("End final coordinates")') - WRITE( stdout, '(/)' ) - ! - DEALLOCATE( tau_out ) - ! - RETURN - ! -END SUBROUTINE output_tau From a4e833eb7f6195b7094fa25a3f40edd3de28ebaf Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Fri, 12 Jul 2019 11:35:04 +0200 Subject: [PATCH 57/95] More I/O cleanup: fermi energy --- Modules/qexsd_copy.f90 | 52 ++++++++++++++++++++++++++------------- PW/src/pw_restart_new.f90 | 24 +----------------- PW/src/setup.f90 | 14 +++++------ 3 files changed, 42 insertions(+), 48 deletions(-) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index f05e759a02..7de17949ba 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -23,7 +23,8 @@ MODULE qexsd_copy qexsd_copy_atomic_species, qexsd_copy_atomic_structure, & qexsd_copy_symmetry, qexsd_copy_algorithmic_info, & qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_band_structure, & - qexsd_copy_efield, qexsd_copy_magnetization, qexsd_copy_kpoints + qexsd_copy_efield, qexsd_copy_magnetization, qexsd_copy_kpoints, & + qexsd_copy_efermi ! CONTAINS !------------------------------------------------------------------------------- @@ -461,11 +462,11 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & REAL(dp), INTENT(out):: nelec, ef, ef_up, ef_dw, xk(:,:), wk(:) REAL(dp), INTENT(inout), ALLOCATABLE :: wg(:,:), et(:,:) ! + LOGICAL :: two_fermi_energies INTEGER :: ik ! lsda = band_struct_obj%lsda nkstot = band_struct_obj%nks - nelec = band_struct_obj%nelec natomwfc = band_struct_obj%num_of_atomic_wfc ! IF ( lsda) THEN @@ -506,20 +507,9 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & nbnd_dw = nbnd isk(1:nkstot) = 1 END IF - ! - IF ( band_struct_obj%fermi_energy_ispresent) THEN - ef = band_struct_obj%fermi_energy - ef_up = 0.d0 - ef_dw = 0.d0 - ELSE IF ( band_struct_obj%two_fermi_energies_ispresent ) THEN - ef = 0.d0 - ef_up = band_struct_obj%two_fermi_energies(1) - ef_dw = band_struct_obj%two_fermi_energies(2) - ELSE - ef = 0.d0 - ef_up = 0.d0 - ef_dw = 0.d0 - END IF + ! + CALL qexsd_copy_efermi ( band_struct_obj, & + nelec, ef, two_fermi_energies, ef_up, ef_dw ) ! IF ( .NOT. ALLOCATED(et) ) ALLOCATE( et(nbnd,nkstot) ) IF ( .NOT. ALLOCATED(wg) ) ALLOCATE( wg(nbnd,nkstot) ) @@ -548,6 +538,34 @@ SUBROUTINE qexsd_copy_band_structure( band_struct_obj, lsda, nkstot, & ! END SUBROUTINE qexsd_copy_band_structure ! + SUBROUTINE qexsd_copy_efermi ( band_struct_obj, & + nelec, ef, two_fermi_energies, ef_up, ef_dw ) + !------------------------------------------------------------------------ + ! + USE qes_types_module, ONLY : band_structure_type + ! + IMPLICIT NONE + TYPE ( band_structure_type) :: band_struct_obj + LOGICAL, INTENT(out) :: two_fermi_energies + REAL(dp), INTENT(out):: nelec, ef, ef_up, ef_dw + ! + nelec = band_struct_obj%nelec + two_fermi_energies = band_struct_obj%two_fermi_energies_ispresent + IF ( band_struct_obj%fermi_energy_ispresent) THEN + ef = band_struct_obj%fermi_energy + ef_up = 0.d0 + ef_dw = 0.d0 + ELSE IF ( two_fermi_energies ) THEN + ef = 0.d0 + ef_up = band_struct_obj%two_fermi_energies(1) + ef_dw = band_struct_obj%two_fermi_energies(2) + ELSE + ef = 0.d0 + ef_up = 0.d0 + ef_dw = 0.d0 + END IF + ! + END SUBROUTINE qexsd_copy_efermi !----------------------------------------------------------------------- SUBROUTINE qexsd_copy_algorithmic_info ( algo_obj, & real_space, tqr, okvan, okpaw ) @@ -702,4 +720,4 @@ SUBROUTINE qexsd_copy_kpoints ( band_struct_obj, nks_start, xk_start,& ! END SUBROUTINE qexsd_copy_kpoints ! - END MODULE qexsd_copy + END MODULE qexsd_copy diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 62a17b0df3..9c42e23712 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -40,7 +40,7 @@ MODULE pw_restart_new PRIVATE PUBLIC :: pw_write_schema, pw_write_binaries, pw_read_schema, & read_collected_to_evc - PUBLIC :: readschema_ef, readschema_occupations + PUBLIC :: readschema_occupations ! CONTAINS !------------------------------------------------------------------------ @@ -1198,27 +1198,5 @@ SUBROUTINE read_collected_to_evc( dirname ) ! END SUBROUTINE read_collected_to_evc ! - !---------------------------------------------------------------------------------------- - SUBROUTINE readschema_ef ( band_struct_obj ) - !---------------------------------------------------------------------------------------- - ! - USE constants, ONLY : e2 - USE ener, ONLY : ef, ef_up, ef_dw - USE klist, ONLY : two_fermi_energies, nelec - USE qes_types_module, ONLY : band_structure_type - ! - IMPLICIT NONE - ! - TYPE ( band_structure_type ),INTENT(IN) :: band_struct_obj - ! - two_fermi_energies = band_struct_obj%two_fermi_energies_ispresent - nelec = band_struct_obj%nelec - IF ( two_fermi_energies) THEN - ef_up = band_struct_obj%two_fermi_energies(1)*e2 - ef_dw = band_struct_obj%two_fermi_energies(2)*e2 - ELSE IF ( band_struct_obj%fermi_energy_ispresent ) THEN - ef = band_struct_obj%fermi_energy*e2 - END IF - END SUBROUTINE readschema_ef !------------------------------------------------------------------------ END MODULE pw_restart_new diff --git a/PW/src/setup.f90 b/PW/src/setup.f90 index 130dfba90d..b748e5226c 100644 --- a/PW/src/setup.f90 +++ b/PW/src/setup.f90 @@ -49,7 +49,7 @@ SUBROUTINE setup() tot_charge, tot_magnetization USE lsda_mod, ONLY : lsda, nspin, current_spin, isk, & starting_magnetization - USE ener, ONLY : ef + USE ener, ONLY : ef, ef_up, ef_dw USE electrons_base, ONLY : set_nelup_neldw USE start_k, ONLY : nks_start, xk_start, wk_start, & nk1, nk2, nk3, k1, k2, k3 @@ -76,7 +76,8 @@ SUBROUTINE setup() USE noncollin_module, ONLY : noncolin, npol, m_loc, i_cons, & angle1, angle2, bfield, ux, nspin_lsda, & nspin_gga, nspin_mag - USE pw_restart_new, ONLY : pw_read_schema, readschema_ef + USE pw_restart_new, ONLY : pw_read_schema + USE qexsd_copy, ONLY : qexsd_copy_efermi USE qes_libs_module, ONLY : qes_reset USE qes_types_module, ONLY : output_type, parallel_info_type, general_info_type USE exx, ONLY : ecutfock, nbndproj @@ -95,8 +96,6 @@ SUBROUTINE setup() LOGICAL, EXTERNAL :: check_para_diag ! TYPE(output_type) :: output_obj - TYPE(parallel_info_type) :: parinfo_obj - TYPE(general_info_type) :: geninfo_obj ! #if defined(__MPI) LOGICAL :: lpara = .true. @@ -164,13 +163,12 @@ SUBROUTINE setup() ! ! ... in these cases, we need to read the Fermi energy ! - CALL pw_read_schema( ierr , output_obj, parinfo_obj, geninfo_obj ) + CALL pw_read_schema( ierr , output_obj ) CALL errore( 'setup ', 'problem reading ef from file ' // & & TRIM( tmp_dir ) // TRIM( prefix ) // '.save', ierr ) - CALL readschema_ef ( output_obj%band_structure) + CALL qexsd_copy_efermi ( output_obj%band_structure, & + nelec, ef, two_fermi_energies, ef_up, ef_dw ) CALL qes_reset ( output_obj ) - CALL qes_reset ( parinfo_obj ) - CALL qes_reset ( geninfo_obj ) ! END IF IF ( (lfcpopt .OR. lfcpdyn) .AND. restart ) THEN From 37e89594c8534032c99d458a461cf10f14415b2a Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Fri, 12 Jul 2019 12:00:22 +0200 Subject: [PATCH 58/95] Prevent possible out of bound error --- CPV/src/restart.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CPV/src/restart.f90 b/CPV/src/restart.f90 index 450d6bcf99..0288b55925 100644 --- a/CPV/src/restart.f90 +++ b/CPV/src/restart.f90 @@ -53,7 +53,7 @@ SUBROUTINE writefile_x & REAL(DP) :: ht(3,3), htm(3,3), htvel(3,3), gvel(3,3) INTEGER :: nk = 1, ispin, i, ib, ierr - REAL(DP) :: xk(3,1) = 0.0d0, wk(1) = 2.0d0 + REAL(DP) :: xk(3,2)=0.0_dp, wk(2)=1.0_dp COMPLEX(DP), ALLOCATABLE :: ctot(:,:) REAL(DP), ALLOCATABLE :: eitot(:,:) INTEGER :: nupdwn_tot( 2 ), iupdwn_tot( 2 ) @@ -152,7 +152,7 @@ subroutine readfile_x & ! REAL(DP) :: ht(3,3), htm(3,3), htvel(3,3), gvel(3,3) integer :: nk = 1, ispin, i, ib, ierr - REAL(DP) :: xk(3,1) = 0.0d0, wk(1) = 2.0d0 + REAL(DP) :: xk(3,2), wk(2) REAL(DP), ALLOCATABLE :: occ_ ( : ) REAL(DP) :: b1(3) , b2(3), b3(3) From e1f2c84ea1ecc40d5062ed4fb7075fcd6739ef27 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Fri, 12 Jul 2019 21:37:26 +0200 Subject: [PATCH 59/95] More I/O cleanup: occupancies --- Modules/qexsd_copy.f90 | 9 ++++++-- PW/src/pw_restart_new.f90 | 45 +++++++++++++-------------------------- PW/src/read_file_new.f90 | 18 ++++++++++------ 3 files changed, 33 insertions(+), 39 deletions(-) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 7de17949ba..94798c8057 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -671,7 +671,7 @@ END SUBROUTINE qexsd_copy_magnetization ! !--------------------------------------------------------------------------- SUBROUTINE qexsd_copy_kpoints ( band_struct_obj, nks_start, xk_start,& - wk_start, nk1, nk2, nk3, k1, k2, k3 ) + wk_start, nk1, nk2, nk3, k1, k2, k3, occupations, smearing, degauss ) !--------------------------------------------------------------------------- ! USE qes_types_module, ONLY : band_structure_type @@ -681,9 +681,14 @@ SUBROUTINE qexsd_copy_kpoints ( band_struct_obj, nks_start, xk_start,& TYPE ( band_structure_type ),INTENT(IN) :: band_struct_obj INTEGER, INTENT(out) :: nks_start, nk1, nk2, nk3, k1, k2, k3 REAL(dp), ALLOCATABLE, INTENT(inout) :: xk_start(:,:), wk_start(:) + REAL(dp), INTENT(out) :: degauss + CHARACTER(LEN=*), intent(out) :: smearing, occupations ! INTEGER :: ik - ! + ! + occupations = TRIM ( band_struct_obj%occupations_kind%occupations ) + smearing = TRIM ( band_struct_obj%smearing%smearing ) + degauss = band_struct_obj%smearing%degauss ! IF ( band_struct_obj%starting_k_points%monkhorst_pack_ispresent ) THEN nks_start = 0 diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 9c42e23712..4918cff60e 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -1004,50 +1004,35 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g END SUBROUTINE pw_read_schema ! !-------------------------------------------------------------------------------------------------- - SUBROUTINE readschema_occupations( band_struct_obj ) + SUBROUTINE readschema_occupations( occupations, smearing, & + ltetra, tetra_type, lgauss, ngauss ) !------------------------------------------------------------------------------------------------ ! - USE ktetra, ONLY : ntetra, tetra_type - USE klist, ONLY : ltetra, lgauss, ngauss, degauss, smearing - USE input_parameters, ONLY : input_parameters_occupations => occupations - USE qes_types_module, ONLY : band_structure_type - ! IMPLICIT NONE - ! - TYPE ( band_structure_type ),INTENT(IN) :: band_struct_obj - INTEGER :: nk1, nk2, nk3 + ! + CHARACTER(LEN=*), INTENT(IN) :: occupations + CHARACTER(LEN=*), INTENT(INOUT) :: smearing + LOGICAL, INTENT(OUT) :: lgauss, ltetra + INTEGER, INTENT(OUT) :: tetra_type, ngauss ! lgauss = .FALSE. ltetra = .FALSE. tetra_type = 0 ngauss = 0 - input_parameters_occupations = TRIM ( band_struct_obj%occupations_kind%occupations ) - IF (TRIM(input_parameters_occupations) == 'tetrahedra' ) THEN + IF (TRIM(occupations) == 'tetrahedra' ) THEN ltetra = .TRUE. - nk1 = band_struct_obj%starting_k_points%monkhorst_pack%nk1 - nk2 = band_struct_obj%starting_k_points%monkhorst_pack%nk2 - nk3 = band_struct_obj%starting_k_points%monkhorst_pack%nk3 - ntetra = 6* nk1 * nk2 * nk3 - ELSE IF (TRIM(input_parameters_occupations) == 'tetrahedra_lin' .OR. & - TRIM(input_parameters_occupations) == 'tetrahedra-lin' ) THEN + tetra_type = 0 + ELSE IF (TRIM(occupations) == 'tetrahedra_lin' .OR. & + TRIM(occupations) == 'tetrahedra-lin' ) THEN ltetra = .TRUE. - nk1 = band_struct_obj%starting_k_points%monkhorst_pack%nk1 - nk2 = band_struct_obj%starting_k_points%monkhorst_pack%nk2 - nk3 = band_struct_obj%starting_k_points%monkhorst_pack%nk3 tetra_type = 1 - ntetra = 6* nk1 * nk2 * nk3 - ELSE IF (TRIM(input_parameters_occupations) == 'tetrahedra_opt' .OR. & - TRIM(input_parameters_occupations) == 'tetrahedra-opt' ) THEN + ELSE IF (TRIM(occupations) == 'tetrahedra_opt' .OR. & + TRIM(occupations) == 'tetrahedra-opt' ) THEN ltetra = .TRUE. - nk1 = band_struct_obj%starting_k_points%monkhorst_pack%nk1 - nk2 = band_struct_obj%starting_k_points%monkhorst_pack%nk2 - nk3 = band_struct_obj%starting_k_points%monkhorst_pack%nk3 tetra_type = 2 - ntetra = 6* nk1 * nk2 * nk3 - ELSE IF ( TRIM (input_parameters_occupations) == 'smearing') THEN + ELSE IF ( TRIM (occupations) == 'smearing') THEN lgauss = .TRUE. - degauss = band_struct_obj%smearing%degauss - SELECT CASE ( TRIM( band_struct_obj%smearing%smearing ) ) + SELECT CASE ( TRIM( smearing ) ) CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) ngauss = 0 smearing = 'gaussian' diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index c264ef6415..045a609a21 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -104,7 +104,8 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE cell_base, ONLY : alat, at, bg, ibrav, celldm, omega USE force_mod, ONLY : force USE klist, ONLY : nks, nkstot, xk, wk, tot_magnetization, & - nelec, nelup, neldw + nelec, nelup, neldw, smearing, degauss, ngauss, lgauss, ltetra + USE ktetra, ONLY : ntetra, tetra_type USE start_k, ONLY : nks_start, xk_start, wk_start, & nk1, nk2, nk3, k1, k2, k3 USE ener, ONLY : ef, ef_up, ef_dw @@ -162,7 +163,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) ! INTEGER :: i, is, ik, ierr, dum1,dum2,dum3 LOGICAL :: magnetic_sym, lvalid_input - CHARACTER(LEN=20) :: dft_name, vdw_corr + CHARACTER(LEN=20) :: dft_name, vdw_corr, occupations REAL(dp) :: exx_fraction, screening_parameter TYPE (output_type) :: output_obj TYPE (parallel_info_type) :: parinfo_obj @@ -277,11 +278,14 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) nspin =1 npol = 1 END IF - ! - CALL readschema_occupations( output_obj%band_structure ) - !! Starting k-òoint information - CALL qexsd_copy_kpoints( output_obj%band_structure, nks_start, & - xk_start, wk_start, nk1, nk2, nk3, k1, k2, k3 ) + !! Information for generating k-points and occupations + CALL qexsd_copy_kpoints( output_obj%band_structure, & + nks_start, xk_start, wk_start, nk1, nk2, nk3, k1, k2, k3, & + occupations, smearing, degauss ) + ! + CALL readschema_occupations( occupations, smearing, & + ltetra, tetra_type, lgauss, ngauss ) + IF ( ltetra) ntetra = 6* nk1 * nk2 * nk3 !! Symmetry section ALLOCATE ( irt(48,nat) ) IF ( lvalid_input ) THEN From 42733801048cc1900e8244bcbbcc26a749d8bfdc Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sat, 13 Jul 2019 08:57:45 +0200 Subject: [PATCH 60/95] Final (?) step of xml I/O cleanup Copy of the xml tags into QE variables is now performed by same routines in qexsd_copy for both PW and CP. Initialization of occupations is done in new routine "set_occupations" both when reading from file and when starting from input data. --- Modules/Makefile | 1 + Modules/make.depend | 2 +- Modules/set_occupations.f90 | 88 +++++++++++++++++++++++++++++++++++++ PP/src/make.depend | 1 + PW/src/input.f90 | 69 ++--------------------------- PW/src/make.depend | 13 ++++-- PW/src/pw_restart_new.f90 | 47 -------------------- PW/src/read_file_new.f90 | 12 ++--- 8 files changed, 110 insertions(+), 123 deletions(-) create mode 100644 Modules/set_occupations.f90 diff --git a/Modules/Makefile b/Modules/Makefile index 5f105d7907..33b38365fc 100644 --- a/Modules/Makefile +++ b/Modules/Makefile @@ -89,6 +89,7 @@ run_info.o \ space_group.o \ set_signal.o \ set_vdw_corr.o \ +set_occupations.o \ setqf.o \ splinelib.o \ timestep.o\ diff --git a/Modules/make.depend b/Modules/make.depend index 163d959ad6..fa1e414ddf 100644 --- a/Modules/make.depend +++ b/Modules/make.depend @@ -176,7 +176,6 @@ mdiis.o : ../UtilXlib/mp.o mdiis.o : kind.o metagga.o : constants.o metagga.o : kind.o -metagga.o : libxc.o mm_dispersion.o : ../UtilXlib/mp.o mm_dispersion.o : cell_base.o mm_dispersion.o : constants.o @@ -368,6 +367,7 @@ remove_tot_torque.o : kind.o rgen.o : kind.o set_hubbard_l.o : io_global.o set_hubbard_n.o : io_global.o +set_occupations.o : kind.o set_signal.o : ../UtilXlib/mp.o set_signal.o : io_global.o set_signal.o : mp_world.o diff --git a/Modules/set_occupations.f90 b/Modules/set_occupations.f90 new file mode 100644 index 0000000000..ab0b190d57 --- /dev/null +++ b/Modules/set_occupations.f90 @@ -0,0 +1,88 @@ +! +! Copyright (C) 2019 Quantum ESPRESSO Foundation +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +!--------------------------------------------------------------------------- +SUBROUTINE set_occupations( occupations, smearing, degauss, & + lfixed, ltetra, tetra_type, lgauss, ngauss ) + !------------------------------------------------------------------------ + USE kinds, ONLY: dp + ! + IMPLICIT NONE + ! + CHARACTER(LEN=*), INTENT(IN) :: occupations + CHARACTER(LEN=*), INTENT(INOUT) :: smearing + REAL(dp), INTENT(INOUT) :: degauss + LOGICAL, INTENT(OUT) :: lfixed, lgauss, ltetra + INTEGER, INTENT(OUT) :: tetra_type, ngauss + ! + lfixed = .FALSE. + ltetra = .FALSE. + tetra_type = 0 + lgauss = .FALSE. + ngauss = 0 + + SELECT CASE( trim( occupations ) ) + CASE( 'fixed' ) + ! + IF ( degauss /= 0.D0 ) THEN + CALL errore( ' set_occupations ', & + & ' fixed occupations, gauss. broadening ignored', -1 ) + degauss = 0.D0 + ENDIF + ! + CASE( 'smearing' ) + ! + lgauss = ( degauss > 0.0_dp ) + IF ( .NOT. lgauss ) CALL errore( ' set_occupations ', & + ' smearing requires gaussian broadening', 1 ) + ! + SELECT CASE ( trim( smearing ) ) + CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) + ngauss = 0 + smearing = 'gaussian' + CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) + ngauss = 1 + smearing = 'Methfessel-Paxton' + CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') + ngauss = -1 + smearing = 'Marzari-Vanderbilt' + CASE ( 'fermi-dirac', 'f-d', 'fd', 'Fermi-Dirac', 'F-D', 'FD') + ngauss = -99 + smearing = 'Fermi-Dirac' + CASE DEFAULT + CALL errore( ' set_occupations ', & + ' smearing '//trim(smearing)//' unknown', 1 ) + END SELECT + ! + CASE( 'tetrahedra' ) + ! + ltetra = .true. + tetra_type = 0 + ! + CASE( 'tetrahedra_lin', 'tetrahedra-lin') + ! + ltetra = .true. + tetra_type = 1 + ! + CASE('tetrahedra_opt', 'tetrahedra-opt') + ! + ltetra = .true. + tetra_type = 2 + ! + CASE( 'from_input' ) + ! + ngauss = 0 + lfixed = .true. + ! + CASE DEFAULT + ! + CALL errore( 'set_occupations', & + 'occupations ' // trim( occupations ) // ' not implemented', 1 ) + ! + END SELECT + ! +END SUBROUTINE set_occupations diff --git a/PP/src/make.depend b/PP/src/make.depend index fe74cbbf86..d959fb0b5d 100644 --- a/PP/src/make.depend +++ b/PP/src/make.depend @@ -88,6 +88,7 @@ bands.o : ../../Modules/uspp.o bands.o : ../../Modules/wavefunctions.o bands.o : ../../PW/src/pwcom.o bands.o : ../../UtilXlib/mp.o +benchmark_libxc.o : ../../Modules/funct.o benchmark_libxc.o : ../../Modules/libxc.o benchmark_libxc.o : ../../Modules/xc_gga_drivers.o benchmark_libxc.o : ../../Modules/xc_lda_lsda_drivers.o diff --git a/PW/src/input.f90 b/PW/src/input.f90 index 88497554eb..7cb33d4afe 100644 --- a/PW/src/input.f90 +++ b/PW/src/input.f90 @@ -549,72 +549,10 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) ! smallmem = ( TRIM( memory ) == 'small' ) ! - ! ... Set Values for electron and bands + ! ... Set occupancies ! - tfixed_occ = .false. - ltetra = .false. - lgauss = .false. - ngauss = 0 - ! - SELECT CASE( trim( occupations ) ) - CASE( 'fixed' ) - ! - IF ( degauss /= 0.D0 ) THEN - CALL errore( ' iosys ', & - & ' fixed occupations, gauss. broadening ignored', -1 ) - degauss = 0.D0 - ENDIF - ! - CASE( 'smearing' ) - ! - lgauss = ( degauss > 0.0_dp ) - IF ( .NOT. lgauss ) & - CALL errore( ' iosys ', & - & ' smearing requires gaussian broadening', 1 ) - ! - SELECT CASE ( trim( smearing ) ) - CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) - ngauss = 0 - smearing_ = 'gaussian' - CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) - ngauss = 1 - smearing_ = 'Methfessel-Paxton' - CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') - ngauss = -1 - smearing_ = 'Marzari-Vanderbilt' - CASE ( 'fermi-dirac', 'f-d', 'fd', 'Fermi-Dirac', 'F-D', 'FD') - ngauss = -99 - smearing_ = 'Fermi-Dirac' - CASE DEFAULT - CALL errore( ' iosys ', ' smearing '//trim(smearing)//' unknown', 1 ) - END SELECT - ! - CASE( 'tetrahedra' ) - ! - ltetra = .true. - tetra_type = 0 - ! - CASE( 'tetrahedra_lin', 'tetrahedra-lin') - ! - ltetra = .true. - tetra_type = 1 - ! - CASE('tetrahedra_opt', 'tetrahedra-opt') - ! - ltetra = .true. - tetra_type = 2 - ! - CASE( 'from_input' ) - ! - ngauss = 0 - tfixed_occ = .true. - ! - CASE DEFAULT - ! - CALL errore( 'iosys','occupations ' // trim( occupations ) // & - & ' not implemented', 1 ) - ! - END SELECT + CALL set_occupations( occupations, smearing, degauss, & + tfixed_occ, ltetra, tetra_type, lgauss, ngauss ) ! IF( ltetra ) THEN IF( lforce ) CALL infomsg( 'iosys', & @@ -622,6 +560,7 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) IF( lstres ) CALL infomsg( 'iosys', & 'BEWARE: stress calculation with tetrahedra (not recommanded)') END IF + ! IF( nbnd < 1 ) & CALL errore( 'iosys', 'nbnd less than 1', nbnd ) ! diff --git a/PW/src/make.depend b/PW/src/make.depend index 2c534d7342..1b29ccaab0 100644 --- a/PW/src/make.depend +++ b/PW/src/make.depend @@ -961,7 +961,6 @@ input.o : ../../Modules/io_global.o input.o : ../../Modules/ions_base.o input.o : ../../Modules/kernel_table.o input.o : ../../Modules/kind.o -input.o : ../../Modules/libxc.o input.o : ../../Modules/mm_dispersion.o input.o : ../../Modules/mp_pools.o input.o : ../../Modules/noncol.o @@ -1520,7 +1519,6 @@ pw_restart_new.o : ../../Modules/bfgs_module.o pw_restart_new.o : ../../Modules/cell_base.o pw_restart_new.o : ../../Modules/constants.o pw_restart_new.o : ../../Modules/control_flags.o -pw_restart_new.o : ../../Modules/electrons_base.o pw_restart_new.o : ../../Modules/fcp_variables.o pw_restart_new.o : ../../Modules/fft_base.o pw_restart_new.o : ../../Modules/funct.o @@ -1530,7 +1528,6 @@ pw_restart_new.o : ../../Modules/io_base.o pw_restart_new.o : ../../Modules/io_files.o pw_restart_new.o : ../../Modules/io_global.o pw_restart_new.o : ../../Modules/ions_base.o -pw_restart_new.o : ../../Modules/kernel_table.o pw_restart_new.o : ../../Modules/kind.o pw_restart_new.o : ../../Modules/mm_dispersion.o pw_restart_new.o : ../../Modules/mp_bands.o @@ -1566,7 +1563,6 @@ pw_restart_new.o : realus.o pw_restart_new.o : scf_mod.o pw_restart_new.o : start_k.o pw_restart_new.o : symm_base.o -pw_restart_new.o : tetra.o pw_restart_new.o : xdm_dispersion.o pwcom.o : ../../Modules/kind.o pwcom.o : ../../Modules/parameters.o @@ -1597,6 +1593,7 @@ read_conf_from_file.o : pw_restart_new.o read_file_new.o : ../../Modules/cell_base.o read_file_new.o : ../../Modules/constants.o read_file_new.o : ../../Modules/control_flags.o +read_file_new.o : ../../Modules/electrons_base.o read_file_new.o : ../../Modules/fft_base.o read_file_new.o : ../../Modules/fft_rho.o read_file_new.o : ../../Modules/funct.o @@ -1606,6 +1603,7 @@ read_file_new.o : ../../Modules/io_global.o read_file_new.o : ../../Modules/ions_base.o read_file_new.o : ../../Modules/kernel_table.o read_file_new.o : ../../Modules/kind.o +read_file_new.o : ../../Modules/mm_dispersion.o read_file_new.o : ../../Modules/mp_global.o read_file_new.o : ../../Modules/mp_images.o read_file_new.o : ../../Modules/noncol.o @@ -1617,12 +1615,16 @@ read_file_new.o : ../../Modules/qexsd_copy.o read_file_new.o : ../../Modules/read_pseudo.o read_file_new.o : ../../Modules/recvec.o read_file_new.o : ../../Modules/recvec_subs.o +read_file_new.o : ../../Modules/tsvdw.o read_file_new.o : ../../Modules/uspp.o read_file_new.o : ../../UtilXlib/mp.o read_file_new.o : Coul_cut_2D.o +read_file_new.o : atomic_wfc_mod.o read_file_new.o : buffers.o read_file_new.o : esm.o read_file_new.o : extfield.o +read_file_new.o : exx.o +read_file_new.o : exx_base.o read_file_new.o : io_rho_xml.o read_file_new.o : ldaU.o read_file_new.o : newd.o @@ -1632,7 +1634,9 @@ read_file_new.o : pw_restart_new.o read_file_new.o : pwcom.o read_file_new.o : realus.o read_file_new.o : scf_mod.o +read_file_new.o : start_k.o read_file_new.o : symm_base.o +read_file_new.o : tetra.o realus.o : ../../FFTXlib/fft_helper_subroutines.o realus.o : ../../FFTXlib/fft_interfaces.o realus.o : ../../FFTXlib/fft_types.o @@ -1835,6 +1839,7 @@ setup.o : ../../Modules/parameters.o setup.o : ../../Modules/paw_variables.o setup.o : ../../Modules/qes_libs_module.o setup.o : ../../Modules/qes_types_module.o +setup.o : ../../Modules/qexsd_copy.o setup.o : ../../Modules/recvec.o setup.o : ../../Modules/uspp.o setup.o : atomic_wfc_mod.o diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 4918cff60e..506b14aee1 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -40,7 +40,6 @@ MODULE pw_restart_new PRIVATE PUBLIC :: pw_write_schema, pw_write_binaries, pw_read_schema, & read_collected_to_evc - PUBLIC :: readschema_occupations ! CONTAINS !------------------------------------------------------------------------ @@ -1003,52 +1002,6 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g ! END SUBROUTINE pw_read_schema ! - !-------------------------------------------------------------------------------------------------- - SUBROUTINE readschema_occupations( occupations, smearing, & - ltetra, tetra_type, lgauss, ngauss ) - !------------------------------------------------------------------------------------------------ - ! - IMPLICIT NONE - ! - CHARACTER(LEN=*), INTENT(IN) :: occupations - CHARACTER(LEN=*), INTENT(INOUT) :: smearing - LOGICAL, INTENT(OUT) :: lgauss, ltetra - INTEGER, INTENT(OUT) :: tetra_type, ngauss - ! - lgauss = .FALSE. - ltetra = .FALSE. - tetra_type = 0 - ngauss = 0 - IF (TRIM(occupations) == 'tetrahedra' ) THEN - ltetra = .TRUE. - tetra_type = 0 - ELSE IF (TRIM(occupations) == 'tetrahedra_lin' .OR. & - TRIM(occupations) == 'tetrahedra-lin' ) THEN - ltetra = .TRUE. - tetra_type = 1 - ELSE IF (TRIM(occupations) == 'tetrahedra_opt' .OR. & - TRIM(occupations) == 'tetrahedra-opt' ) THEN - ltetra = .TRUE. - tetra_type = 2 - ELSE IF ( TRIM (occupations) == 'smearing') THEN - lgauss = .TRUE. - SELECT CASE ( TRIM( smearing ) ) - CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) - ngauss = 0 - smearing = 'gaussian' - CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) - ngauss = 1 - smearing = 'mp' - CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') - ngauss = -1 - smearing = 'mv' - CASE ( 'fermi-dirac', 'f-d', 'fd', 'Fermi-Dirac', 'F-D', 'FD') - ngauss = -99 - smearing = 'fd' - END SELECT - END IF - ! - END SUBROUTINE readschema_occupations ! !------------------------------------------------------------------------ SUBROUTINE read_collected_to_evc( dirname ) diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 045a609a21..a0579a57ff 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -141,8 +141,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE uspp, ONLY : okvan USE paw_variables, ONLY : okpaw ! - USE pw_restart_new, ONLY : pw_read_schema, & - readschema_occupations + USE pw_restart_new, ONLY : pw_read_schema USE qes_types_module,ONLY : output_type, parallel_info_type, & general_info_type, input_type USE qes_libs_module, ONLY : qes_reset @@ -162,7 +161,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) LOGICAL, INTENT(OUT) :: wfc_is_collected ! INTEGER :: i, is, ik, ierr, dum1,dum2,dum3 - LOGICAL :: magnetic_sym, lvalid_input + LOGICAL :: magnetic_sym, lvalid_input, lfixed CHARACTER(LEN=20) :: dft_name, vdw_corr, occupations REAL(dp) :: exx_fraction, screening_parameter TYPE (output_type) :: output_obj @@ -283,9 +282,10 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) nks_start, xk_start, wk_start, nk1, nk2, nk3, k1, k2, k3, & occupations, smearing, degauss ) ! - CALL readschema_occupations( occupations, smearing, & - ltetra, tetra_type, lgauss, ngauss ) - IF ( ltetra) ntetra = 6* nk1 * nk2 * nk3 + CALL set_occupations( occupations, smearing, degauss, & + lfixed, ltetra, tetra_type, lgauss, ngauss ) + IF (ltetra) ntetra = 6* nk1 * nk2 * nk3 + IF (lfixed) CALL errore('read_file','bad occupancies',1) !! Symmetry section ALLOCATE ( irt(48,nat) ) IF ( lvalid_input ) THEN From 0c73b496bc7fa0cde03f9cf94d87f3987ab849da Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sat, 13 Jul 2019 21:23:32 +0200 Subject: [PATCH 61/95] Removal of USE input_parameters Module input_parameters should be used ONLY to read input variables. Once variables are read, they must be copied into QE modules and input_parameters should be no longer used. Morever, input_parameters is initialized ONLY when input is read, NOT when the data file is read. --- GWW/head/make.depend | 1 - GWW/head/phq_readin.f90 | 3 +-- HP/src/hp_bcast_input.f90 | 2 +- HP/src/hp_readin.f90 | 2 +- HP/src/make.depend | 4 ++-- PHonon/PH/bcast_ph_input.f90 | 2 +- PHonon/PH/make.depend | 5 ++--- PHonon/PH/openfilq.f90 | 2 +- PHonon/PH/phq_readin.f90 | 3 +-- PP/src/make.depend | 1 - PP/src/open_grid.f90 | 7 +------ TDDFPT/src/lr_readin.f90 | 2 +- 12 files changed, 12 insertions(+), 22 deletions(-) diff --git a/GWW/head/make.depend b/GWW/head/make.depend index 27bbfc1e32..8f3d9699c6 100644 --- a/GWW/head/make.depend +++ b/GWW/head/make.depend @@ -59,7 +59,6 @@ openfilq.o : ../../PW/src/pwcom.o phq_readin.o : ../../LR_Modules/lrcom.o phq_readin.o : ../../Modules/check_stop.o phq_readin.o : ../../Modules/control_flags.o -phq_readin.o : ../../Modules/input_parameters.o phq_readin.o : ../../Modules/io_files.o phq_readin.o : ../../Modules/io_global.o phq_readin.o : ../../Modules/ions_base.o diff --git a/GWW/head/phq_readin.f90 b/GWW/head/phq_readin.f90 index 42fe86e818..0633d2ae00 100644 --- a/GWW/head/phq_readin.f90 +++ b/GWW/head/phq_readin.f90 @@ -25,8 +25,7 @@ SUBROUTINE phq_readin() USE mp_world, ONLY : world_comm USE ions_base, ONLY : amass, atm USE check_stop, ONLY : max_seconds - USE input_parameters, ONLY : nk1, nk2, nk3, k1, k2, k3 - USE start_k, ONLY : reset_grid + USE start_k, ONLY : reset_grid, nk1, nk2, nk3, k1, k2, k3 USE klist, ONLY : xk, nks, nkstot, lgauss, two_fermi_energies, ltetra USE control_flags, ONLY : gamma_only, tqr, restart USE uspp, ONLY : okvan diff --git a/HP/src/hp_bcast_input.f90 b/HP/src/hp_bcast_input.f90 index 51688d1f83..03e4b98656 100644 --- a/HP/src/hp_bcast_input.f90 +++ b/HP/src/hp_bcast_input.f90 @@ -19,7 +19,7 @@ SUBROUTINE hp_bcast_input ( ) USE mp_world, ONLY : world_comm USE io_files, ONLY : tmp_dir, prefix USE control_flags, ONLY : iverbosity - USE input_parameters, ONLY : max_seconds + USE check_stop, ONLY : max_seconds USE io_global, ONLY : meta_ionode_id USE control_lr, ONLY : lrpa, ethr_nscf USE ldaU_hp, ONLY : conv_thr_chi, thresh_init, find_atpert, skip_atom, & diff --git a/HP/src/hp_readin.f90 b/HP/src/hp_readin.f90 index 86e38b8ee8..5082ba405d 100644 --- a/HP/src/hp_readin.f90 +++ b/HP/src/hp_readin.f90 @@ -17,7 +17,7 @@ SUBROUTINE hp_readin() USE io_global, ONLY : meta_ionode, meta_ionode_id USE mp, ONLY : mp_bcast USE mp_world, ONLY : world_comm - USE input_parameters, ONLY : max_seconds + USE check_stop, ONLY : max_seconds USE io_files, ONLY : tmp_dir, prefix, create_directory USE control_flags, ONLY : iverbosity USE control_lr, ONLY : ethr_nscf, lrpa diff --git a/HP/src/make.depend b/HP/src/make.depend index 6c6dab8b8e..4714c6744c 100644 --- a/HP/src/make.depend +++ b/HP/src/make.depend @@ -11,8 +11,8 @@ hp_allocate_q.o : ../../PW/src/ldaU.o hp_allocate_q.o : ../../PW/src/pwcom.o hp_allocate_q.o : hpcom.o hp_bcast_input.o : ../../LR_Modules/lrcom.o +hp_bcast_input.o : ../../Modules/check_stop.o hp_bcast_input.o : ../../Modules/control_flags.o -hp_bcast_input.o : ../../Modules/input_parameters.o hp_bcast_input.o : ../../Modules/io_files.o hp_bcast_input.o : ../../Modules/io_global.o hp_bcast_input.o : ../../Modules/mp_world.o @@ -203,8 +203,8 @@ hp_read_dnsq.o : ../../PW/src/ldaU.o hp_read_dnsq.o : ../../PW/src/pwcom.o hp_read_dnsq.o : hpcom.o hp_readin.o : ../../LR_Modules/lrcom.o +hp_readin.o : ../../Modules/check_stop.o hp_readin.o : ../../Modules/control_flags.o -hp_readin.o : ../../Modules/input_parameters.o hp_readin.o : ../../Modules/io_files.o hp_readin.o : ../../Modules/io_global.o hp_readin.o : ../../Modules/kind.o diff --git a/PHonon/PH/bcast_ph_input.f90 b/PHonon/PH/bcast_ph_input.f90 index 4b454872a7..0aab6b465c 100644 --- a/PHonon/PH/bcast_ph_input.f90 +++ b/PHonon/PH/bcast_ph_input.f90 @@ -32,7 +32,7 @@ subroutine bcast_ph_input ( ) USE control_flags, only: iverbosity, modenum USE ramanm, ONLY: lraman, elop, dek, eth_rps, eth_ns USE check_stop, ONLY: max_seconds - USE input_parameters, ONLY : nk1, nk2, nk3, k1, k2, k3 + USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3 USE ions_base, ONLY : amass USE io_global, ONLY : meta_ionode_id USE run_info, ONLY : title diff --git a/PHonon/PH/make.depend b/PHonon/PH/make.depend index c0d40f0320..dd81bc1bd1 100644 --- a/PHonon/PH/make.depend +++ b/PHonon/PH/make.depend @@ -144,12 +144,12 @@ alpha2f.o : phcom.o bcast_ph_input.o : ../../LR_Modules/lrcom.o bcast_ph_input.o : ../../Modules/check_stop.o bcast_ph_input.o : ../../Modules/control_flags.o -bcast_ph_input.o : ../../Modules/input_parameters.o bcast_ph_input.o : ../../Modules/io_files.o bcast_ph_input.o : ../../Modules/io_global.o bcast_ph_input.o : ../../Modules/ions_base.o bcast_ph_input.o : ../../Modules/mp_world.o bcast_ph_input.o : ../../Modules/run_info.o +bcast_ph_input.o : ../../PW/src/start_k.o bcast_ph_input.o : ../../UtilXlib/mp.o bcast_ph_input.o : dfile_star.o bcast_ph_input.o : elph.o @@ -1024,7 +1024,6 @@ openfilq.o : ../../LR_Modules/lrcom.o openfilq.o : ../../Modules/cell_base.o openfilq.o : ../../Modules/control_flags.o openfilq.o : ../../Modules/fft_base.o -openfilq.o : ../../Modules/input_parameters.o openfilq.o : ../../Modules/io_files.o openfilq.o : ../../Modules/io_global.o openfilq.o : ../../Modules/ions_base.o @@ -1036,6 +1035,7 @@ openfilq.o : ../../Modules/uspp.o openfilq.o : ../../PW/src/buffers.o openfilq.o : ../../PW/src/ldaU.o openfilq.o : ../../PW/src/pwcom.o +openfilq.o : ../../PW/src/start_k.o openfilq.o : acfdtest.o openfilq.o : dfile_autoname.o openfilq.o : dfile_star.o @@ -1123,7 +1123,6 @@ phq_readin.o : ../../Modules/check_stop.o phq_readin.o : ../../Modules/control_flags.o phq_readin.o : ../../Modules/fft_base.o phq_readin.o : ../../Modules/funct.o -phq_readin.o : ../../Modules/input_parameters.o phq_readin.o : ../../Modules/io_files.o phq_readin.o : ../../Modules/io_global.o phq_readin.o : ../../Modules/ions_base.o diff --git a/PHonon/PH/openfilq.f90 b/PHonon/PH/openfilq.f90 index 7cdb9b6539..b1e1abeac4 100644 --- a/PHonon/PH/openfilq.f90 +++ b/PHonon/PH/openfilq.f90 @@ -41,7 +41,7 @@ SUBROUTINE openfilq() USE buffers, ONLY : open_buffer, close_buffer USE ramanm, ONLY : lraman, elop, iuchf, iud2w, iuba2, lrchf, lrd2w, lrba2 USE acfdtest, ONLY : acfdt_is_active, acfdt_num_der - USE input_parameters,ONLY : nk1, nk2, nk3 + USE start_k, ONLY : nk1, nk2, nk3 USE el_phon, ONLY : elph, elph_mat, iunwfcwann, lrwfcr USE dfile_star, ONLY : dvscf_star USE dfile_autoname, ONLY : dfile_name diff --git a/PHonon/PH/phq_readin.f90 b/PHonon/PH/phq_readin.f90 index 0880442277..930f6e43d5 100644 --- a/PHonon/PH/phq_readin.f90 +++ b/PHonon/PH/phq_readin.f90 @@ -22,8 +22,7 @@ SUBROUTINE phq_readin() USE mp_world, ONLY : world_comm USE ions_base, ONLY : amass, atm USE check_stop, ONLY : max_seconds - USE input_parameters, ONLY : nk1, nk2, nk3, k1, k2, k3 - USE start_k, ONLY : reset_grid + USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3, reset_grid USE klist, ONLY : xk, nks, nkstot, lgauss, two_fermi_energies, ltetra USE control_flags, ONLY : gamma_only, tqr, restart, io_level, & ts_vdw, ldftd3, lxdm diff --git a/PP/src/make.depend b/PP/src/make.depend index d959fb0b5d..7e9e0c73bb 100644 --- a/PP/src/make.depend +++ b/PP/src/make.depend @@ -336,7 +336,6 @@ open_grid.o : ../../Modules/environment.o open_grid.o : ../../Modules/fft_base.o open_grid.o : ../../Modules/funct.o open_grid.o : ../../Modules/gvecw.o -open_grid.o : ../../Modules/input_parameters.o open_grid.o : ../../Modules/io_files.o open_grid.o : ../../Modules/io_global.o open_grid.o : ../../Modules/ions_base.o diff --git a/PP/src/open_grid.f90 b/PP/src/open_grid.f90 index 8f4bfe548c..b84a6ec6cc 100644 --- a/PP/src/open_grid.f90 +++ b/PP/src/open_grid.f90 @@ -30,15 +30,13 @@ PROGRAM open_grid USE scf, ONLY : rho USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization USE io_rho_xml, ONLY : write_scf - USE input_parameters, ONLY : nk1, nk2, nk3, k1, k2, k3, k_points, & - occupations, calculation !, nkstot, + USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3 USE noncollin_module, ONLY : nspin_mag, npol USE fft_interfaces, ONLY : fwfft ! USE qexsd_module, ONLY : qexsd_input_obj USE qes_types_module, ONLY : input_type USE fft_base, ONLY : dffts - !USE qexsd_input, ONLY : qexsd_init_k_points_ibz USE control_flags, ONLY : gamma_only, io_level USE start_k, ONLY : init_start_k USE extfield, ONLY : gate @@ -216,9 +214,6 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) nk1 = nq1 nk2 = nq2 nk3 = nq3 - calculation = 'bands' - k_points = "automatic" - !CALL init_start_k(nk1,nk2,nk3, k1, k2, k3, "automatic",nks/nspin_mag, xk, wk) CALL init_start_k(nk1,nk2,nk3, k1, k2, k3, "automatic",nks/nspin_lsda, xk, wk) ! ! Restore EXX variables diff --git a/TDDFPT/src/lr_readin.f90 b/TDDFPT/src/lr_readin.f90 index 775f0d9e46..80cd183a1f 100644 --- a/TDDFPT/src/lr_readin.f90 +++ b/TDDFPT/src/lr_readin.f90 @@ -30,7 +30,7 @@ SUBROUTINE lr_readin USE io_global, ONLY : ionode, ionode_id, stdout USE klist, ONLY : nks, wk, nelec, lgauss, ltetra USE fixed_occ, ONLY : tfixed_occ - USE input_parameters, ONLY : degauss, nosym, wfcdir, outdir + USE input_parameters, ONLY : nosym, wfcdir, outdir USE check_stop, ONLY : max_seconds USE realus, ONLY : real_space, init_realspace_vars, generate_qpointlist, & betapointlist From 0bd3bd57a813d8de14dfbb9a1ae097ae8085d179 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sun, 14 Jul 2019 07:41:13 +0200 Subject: [PATCH 62/95] Forgotten setting of a character variable broke the buildbot --- Modules/set_occupations.f90 | 13 +++++++------ PW/src/input.f90 | 2 +- PW/src/read_file_new.f90 | 2 +- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/Modules/set_occupations.f90 b/Modules/set_occupations.f90 index ab0b190d57..cc446481cd 100644 --- a/Modules/set_occupations.f90 +++ b/Modules/set_occupations.f90 @@ -7,14 +7,15 @@ ! !--------------------------------------------------------------------------- SUBROUTINE set_occupations( occupations, smearing, degauss, & - lfixed, ltetra, tetra_type, lgauss, ngauss ) + lfixed, ltetra, tetra_type, smearing_, lgauss, ngauss ) !------------------------------------------------------------------------ USE kinds, ONLY: dp ! IMPLICIT NONE ! CHARACTER(LEN=*), INTENT(IN) :: occupations - CHARACTER(LEN=*), INTENT(INOUT) :: smearing + CHARACTER(LEN=*), INTENT(IN) :: smearing + CHARACTER(LEN=*), INTENT(OUT):: smearing_ REAL(dp), INTENT(INOUT) :: degauss LOGICAL, INTENT(OUT) :: lfixed, lgauss, ltetra INTEGER, INTENT(OUT) :: tetra_type, ngauss @@ -43,16 +44,16 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & SELECT CASE ( trim( smearing ) ) CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) ngauss = 0 - smearing = 'gaussian' + smearing_ = 'Gaussian' CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) ngauss = 1 - smearing = 'Methfessel-Paxton' + smearing_ = 'Methfessel-Paxton' CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') ngauss = -1 - smearing = 'Marzari-Vanderbilt' + smearing_ = 'Marzari-Vanderbilt' CASE ( 'fermi-dirac', 'f-d', 'fd', 'Fermi-Dirac', 'F-D', 'FD') ngauss = -99 - smearing = 'Fermi-Dirac' + smearing_ = 'Fermi-Dirac' CASE DEFAULT CALL errore( ' set_occupations ', & ' smearing '//trim(smearing)//' unknown', 1 ) diff --git a/PW/src/input.f90 b/PW/src/input.f90 index 7cb33d4afe..7c47546c90 100644 --- a/PW/src/input.f90 +++ b/PW/src/input.f90 @@ -552,7 +552,7 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) ! ... Set occupancies ! CALL set_occupations( occupations, smearing, degauss, & - tfixed_occ, ltetra, tetra_type, lgauss, ngauss ) + tfixed_occ, ltetra, tetra_type, smearing_, lgauss, ngauss ) ! IF( ltetra ) THEN IF( lforce ) CALL infomsg( 'iosys', & diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index a0579a57ff..dbfa7c0d2b 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -283,7 +283,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) occupations, smearing, degauss ) ! CALL set_occupations( occupations, smearing, degauss, & - lfixed, ltetra, tetra_type, lgauss, ngauss ) + lfixed, ltetra, tetra_type, smearing, lgauss, ngauss ) IF (ltetra) ntetra = 6* nk1 * nk2 * nk3 IF (lfixed) CALL errore('read_file','bad occupancies',1) !! Symmetry section From 1c10775112da862aadd65c406881a4dfceefb1d2 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sun, 14 Jul 2019 07:45:37 +0200 Subject: [PATCH 63/95] Better to be on the safe side --- Modules/set_occupations.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/Modules/set_occupations.f90 b/Modules/set_occupations.f90 index cc446481cd..a60b88e8b4 100644 --- a/Modules/set_occupations.f90 +++ b/Modules/set_occupations.f90 @@ -23,6 +23,7 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & lfixed = .FALSE. ltetra = .FALSE. tetra_type = 0 + smearing_ = 'none' lgauss = .FALSE. ngauss = 0 From d115c074567564b9d32d0faee2db1bae212b3d11 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sun, 14 Jul 2019 10:57:37 +0200 Subject: [PATCH 64/95] References to input_parameters removed --- TDDFPT/src/lr_readin.f90 | 3 ++- TDDFPT/src/make.depend | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/TDDFPT/src/lr_readin.f90 b/TDDFPT/src/lr_readin.f90 index 80cd183a1f..ff1cab6482 100644 --- a/TDDFPT/src/lr_readin.f90 +++ b/TDDFPT/src/lr_readin.f90 @@ -30,7 +30,7 @@ SUBROUTINE lr_readin USE io_global, ONLY : ionode, ionode_id, stdout USE klist, ONLY : nks, wk, nelec, lgauss, ltetra USE fixed_occ, ONLY : tfixed_occ - USE input_parameters, ONLY : nosym, wfcdir, outdir + USE symm_base, ONLY : nosym USE check_stop, ONLY : max_seconds USE realus, ONLY : real_space, init_realspace_vars, generate_qpointlist, & betapointlist @@ -54,6 +54,7 @@ SUBROUTINE lr_readin IMPLICIT NONE ! + CHARACTER(LEN=256) :: wfcdir, outdir CHARACTER(LEN=256), EXTERNAL :: trimcheck ! CHARACTER(LEN=256) :: beta_gamma_z_prefix diff --git a/TDDFPT/src/make.depend b/TDDFPT/src/make.depend index d18925f655..ad59375737 100644 --- a/TDDFPT/src/make.depend +++ b/TDDFPT/src/make.depend @@ -408,7 +408,6 @@ lr_readin.o : ../../Modules/constants.o lr_readin.o : ../../Modules/control_flags.o lr_readin.o : ../../Modules/fft_base.o lr_readin.o : ../../Modules/funct.o -lr_readin.o : ../../Modules/input_parameters.o lr_readin.o : ../../Modules/io_files.o lr_readin.o : ../../Modules/io_global.o lr_readin.o : ../../Modules/kind.o @@ -425,6 +424,7 @@ lr_readin.o : ../../PW/src/newd.o lr_readin.o : ../../PW/src/pwcom.o lr_readin.o : ../../PW/src/realus.o lr_readin.o : ../../PW/src/scf_mod.o +lr_readin.o : ../../PW/src/symm_base.o lr_readin.o : ../../UtilXlib/mp.o lr_readin.o : lr_charg_resp.o lr_readin.o : lr_dav_variables.o From 7884c7a8f1736362762b807e3561516acd535259 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Mon, 15 Jul 2019 08:22:15 +0200 Subject: [PATCH 65/95] Fixed dumb mistake in yesterday's commit that was breaking (once again) the buildbot for all cases with smearing. Setup of spin variables moved to a single place --- Modules/Makefile | 1 - Modules/make.depend | 1 - PW/src/Makefile | 2 + PW/src/input.f90 | 3 +- PW/src/make.depend | 2 +- PW/src/pw_restart_new.f90 | 4 -- PW/src/read_file_new.f90 | 60 +++++--------------- {Modules => PW/src}/set_occupations.f90 | 23 +++++--- PW/src/set_spin_vars.f90 | 56 +++++++++++++++++++ PW/src/setup.f90 | 74 ++++++++++--------------- 10 files changed, 118 insertions(+), 108 deletions(-) rename {Modules => PW/src}/set_occupations.f90 (85%) create mode 100644 PW/src/set_spin_vars.f90 diff --git a/Modules/Makefile b/Modules/Makefile index 33b38365fc..5f105d7907 100644 --- a/Modules/Makefile +++ b/Modules/Makefile @@ -89,7 +89,6 @@ run_info.o \ space_group.o \ set_signal.o \ set_vdw_corr.o \ -set_occupations.o \ setqf.o \ splinelib.o \ timestep.o\ diff --git a/Modules/make.depend b/Modules/make.depend index fa1e414ddf..78609f015f 100644 --- a/Modules/make.depend +++ b/Modules/make.depend @@ -367,7 +367,6 @@ remove_tot_torque.o : kind.o rgen.o : kind.o set_hubbard_l.o : io_global.o set_hubbard_n.o : io_global.o -set_occupations.o : kind.o set_signal.o : ../UtilXlib/mp.o set_signal.o : io_global.o set_signal.o : mp_world.o diff --git a/PW/src/Makefile b/PW/src/Makefile index 7ef9c19092..ecb96eb0bc 100644 --- a/PW/src/Makefile +++ b/PW/src/Makefile @@ -189,7 +189,9 @@ loc_scdm_k.o \ scf_mod.o \ set_kplusq.o \ set_kup_and_kdw.o \ +set_occupations.o \ set_rhoc.o \ +set_spin_vars.o \ set_vrs.o \ setlocal.o \ setup.o \ diff --git a/PW/src/input.f90 b/PW/src/input.f90 index 7c47546c90..8b1d0b9625 100644 --- a/PW/src/input.f90 +++ b/PW/src/input.f90 @@ -552,7 +552,8 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) ! ... Set occupancies ! CALL set_occupations( occupations, smearing, degauss, & - tfixed_occ, ltetra, tetra_type, smearing_, lgauss, ngauss ) + tfixed_occ, ltetra, tetra_type, lgauss, ngauss ) + smearing_ = smearing ! IF( ltetra ) THEN IF( lforce ) CALL infomsg( 'iosys', & diff --git a/PW/src/make.depend b/PW/src/make.depend index 1b29ccaab0..4309190996 100644 --- a/PW/src/make.depend +++ b/PW/src/make.depend @@ -1535,7 +1535,6 @@ pw_restart_new.o : ../../Modules/mp_pools.o pw_restart_new.o : ../../Modules/noncol.o pw_restart_new.o : ../../Modules/paw_variables.o pw_restart_new.o : ../../Modules/qes_init_module.o -pw_restart_new.o : ../../Modules/qes_libs_module.o pw_restart_new.o : ../../Modules/qes_read_module.o pw_restart_new.o : ../../Modules/qes_reset_module.o pw_restart_new.o : ../../Modules/qes_types_module.o @@ -1785,6 +1784,7 @@ scf_mod.o : paw_onecenter.o scf_mod.o : pwcom.o set_kplusq.o : ../../Modules/kind.o set_kup_and_kdw.o : ../../Modules/kind.o +set_occupations.o : ../../Modules/kind.o set_rhoc.o : ../../Modules/atom.o set_rhoc.o : ../../Modules/cell_base.o set_rhoc.o : ../../Modules/fft_base.o diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 506b14aee1..f799d82898 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -910,7 +910,6 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g !------------------------------------------------------------------------ USE qes_types_module, ONLY : input_type, output_type, general_info_type, parallel_info_type ! - USE qes_libs_module, ONLY : qes_write USE FoX_dom, ONLY : parseFile, item, getElementsByTagname, destroy, nodeList, Node USE qes_read_module, ONLY : qes_read IMPLICIT NONE @@ -956,7 +955,6 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g errmsg='error reading header of xml data file' GOTO 100 END IF - ! CALL qes_write_general_info( 82, restart_general_info) END IF ! IF ( PRESENT ( restart_parallel_info ) ) THEN @@ -967,7 +965,6 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g errmsg='error parallel_info of xsd data file' GOTO 100 END IF - ! CALL qes_write_parallel_info ( 82, restart_parallel_info ) END IF ! IF ( PRESENT ( restart_output ) ) THEN @@ -978,7 +975,6 @@ SUBROUTINE pw_read_schema(ierr, restart_output, restart_parallel_info, restart_g GOTO 100 END IF ! - !CALL qes_write_output ( 82, restart_output ) END IF ! IF (PRESENT (prev_input)) THEN diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index dbfa7c0d2b..bca6d61e81 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -133,9 +133,11 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, ldftd3, & lxdm, ts_vdw USE Coul_cut_2D, ONLY : do_cutoff_2D - USE noncollin_module,ONLY : noncolin, npol, angle1, angle2, bfield + USE noncollin_module,ONLY : noncolin, npol, angle1, angle2, bfield, & + nspin_lsda, nspin_gga, nspin_mag USE spin_orb, ONLY : domag, lspinorb - USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization + USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization,& + current_spin USE realus, ONLY : real_space USE basis, ONLY : natomwfc USE uspp, ONLY : okvan @@ -264,28 +266,20 @@ SUBROUTINE read_xml_file ( wfc_is_collected ) lspinorb, domag, tot_magnetization ) ! bfield = 0.d0 - IF ( lsda ) THEN - nspin = 2 - npol = 1 - ! FIXME: next line makes sense only for fixed occupations - ! FIXME: is this really needed? do we use nelup and neldw? - CALL set_nelup_neldw(tot_magnetization, nelec, nelup, neldw) - ELSE IF (noncolin ) THEN - nspin = 4 - npol = 2 - ELSE - nspin =1 - npol = 1 - END IF + CALL set_spin_vars( lsda, noncolin, lspinorb, domag, & + npol, nspin, nspin_lsda, nspin_mag, nspin_gga, current_spin ) !! Information for generating k-points and occupations CALL qexsd_copy_kpoints( output_obj%band_structure, & nks_start, xk_start, wk_start, nk1, nk2, nk3, k1, k2, k3, & occupations, smearing, degauss ) ! CALL set_occupations( occupations, smearing, degauss, & - lfixed, ltetra, tetra_type, smearing, lgauss, ngauss ) + lfixed, ltetra, tetra_type, lgauss, ngauss ) IF (ltetra) ntetra = 6* nk1 * nk2 * nk3 IF (lfixed) CALL errore('read_file','bad occupancies',1) + ! FIXME: is this really needed? do we use nelup and neldw? + IF ( lfixed .AND. lsda ) & + CALL set_nelup_neldw(tot_magnetization, nelec, nelup, neldw) !! Symmetry section ALLOCATE ( irt(48,nat) ) IF ( lvalid_input ) THEN @@ -346,8 +340,6 @@ SUBROUTINE post_xml_init ( ) USE paw_init, ONLY : paw_init_onecenter, allocate_paw_internals USE paw_onecenter, ONLY : paw_potential USE dfunct, ONLY : newd - USE noncollin_module, ONLY : noncolin - USE spin_orb, ONLY : lspinorb USE funct, ONLY : get_inlc, get_dft_name USE kernel_table, ONLY : initialize_kernel_table USE ldaU, ONLY : lda_plus_u, eth, init_lda_plus_u, U_projection @@ -368,6 +360,8 @@ SUBROUTINE post_xml_init ( ) USE cellmd, ONLY : cell_factor, lmovecell USE wvfct, ONLY : nbnd, nbndx, et, wg USE lsda_mod, ONLY : nspin + USE noncollin_module, ONLY : noncolin + USE spin_orb, ONLY : lspinorb USE cell_base, ONLY : at, bg, set_h_ainv USE symm_base, ONLY : d1, d2, d3 USE realus, ONLY : betapointlist, generate_qpointlist, & @@ -379,11 +373,10 @@ SUBROUTINE post_xml_init ( ) REAL(DP) :: ehart, etxc, vtxc, etotefield, charge CHARACTER(LEN=20) :: dft_name ! - ! ... set spin variables, G cutoffs, cell factor (FIXME: from setup.f90?) + ! ... set G cutoffs and cell factor (FIXME: from setup.f90?) ! CALL set_gcut() if (cell_factor == 0.d0) cell_factor = 1.D0 - CALL set_spin_vars ( ) nbndx = nbnd ! ! ... read pseudopotentials @@ -515,31 +508,4 @@ SUBROUTINE set_gcut() ! END SUBROUTINE set_gcut ! - !------------------------------------------------------------------------ - SUBROUTINE set_spin_vars( ) - !------------------------------------------------------------------------ - ! - ! Set various spin-related variables - ! - USE noncollin_module, ONLY : nspin_lsda, nspin_mag, nspin_gga - USE spin_orb, ONLY : domag - USE lsda_mod, ONLY : nspin, current_spin - ! - IF (nspin /= 2) current_spin = 1 - ! - nspin_mag = nspin - nspin_lsda = nspin - nspin_gga = nspin - IF (nspin==4) THEN - nspin_lsda=1 - IF (domag) THEN - nspin_gga=2 - ELSE - nspin_gga=1 - nspin_mag=1 - ENDIF - ENDIF - ! - END SUBROUTINE set_spin_vars - ! END SUBROUTINE post_xml_init diff --git a/Modules/set_occupations.f90 b/PW/src/set_occupations.f90 similarity index 85% rename from Modules/set_occupations.f90 rename to PW/src/set_occupations.f90 index a60b88e8b4..9e91366ed8 100644 --- a/Modules/set_occupations.f90 +++ b/PW/src/set_occupations.f90 @@ -7,15 +7,14 @@ ! !--------------------------------------------------------------------------- SUBROUTINE set_occupations( occupations, smearing, degauss, & - lfixed, ltetra, tetra_type, smearing_, lgauss, ngauss ) + lfixed, ltetra, tetra_type, lgauss, ngauss ) !------------------------------------------------------------------------ USE kinds, ONLY: dp ! IMPLICIT NONE ! CHARACTER(LEN=*), INTENT(IN) :: occupations - CHARACTER(LEN=*), INTENT(IN) :: smearing - CHARACTER(LEN=*), INTENT(OUT):: smearing_ + CHARACTER(LEN=*), INTENT(INOUT) :: smearing REAL(dp), INTENT(INOUT) :: degauss LOGICAL, INTENT(OUT) :: lfixed, lgauss, ltetra INTEGER, INTENT(OUT) :: tetra_type, ngauss @@ -23,7 +22,6 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & lfixed = .FALSE. ltetra = .FALSE. tetra_type = 0 - smearing_ = 'none' lgauss = .FALSE. ngauss = 0 @@ -35,6 +33,7 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & & ' fixed occupations, gauss. broadening ignored', -1 ) degauss = 0.D0 ENDIF + smearing = 'none' ! CASE( 'smearing' ) ! @@ -45,16 +44,16 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & SELECT CASE ( trim( smearing ) ) CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) ngauss = 0 - smearing_ = 'Gaussian' + smearing = 'Gaussian' CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) ngauss = 1 - smearing_ = 'Methfessel-Paxton' + smearing = 'Methfessel-Paxton' CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') ngauss = -1 - smearing_ = 'Marzari-Vanderbilt' + smearing = 'Marzari-Vanderbilt' CASE ( 'fermi-dirac', 'f-d', 'fd', 'Fermi-Dirac', 'F-D', 'FD') ngauss = -99 - smearing_ = 'Fermi-Dirac' + smearing = 'Fermi-Dirac' CASE DEFAULT CALL errore( ' set_occupations ', & ' smearing '//trim(smearing)//' unknown', 1 ) @@ -64,21 +63,29 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & ! ltetra = .true. tetra_type = 0 + smearing = 'none' + ! ! CASE( 'tetrahedra_lin', 'tetrahedra-lin') ! ltetra = .true. tetra_type = 1 + smearing = 'none' + ! ! CASE('tetrahedra_opt', 'tetrahedra-opt') ! ltetra = .true. tetra_type = 2 + smearing = 'none' + ! ! CASE( 'from_input' ) ! ngauss = 0 lfixed = .true. + smearing = 'none' + ! ! CASE DEFAULT ! diff --git a/PW/src/set_spin_vars.f90 b/PW/src/set_spin_vars.f90 new file mode 100644 index 0000000000..da55dd785f --- /dev/null +++ b/PW/src/set_spin_vars.f90 @@ -0,0 +1,56 @@ +! +! Copyright (C) 2019 Quantum ESPRESSO group +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +!------------------------------------------------------------------------ +SUBROUTINE set_spin_vars( lsda, noncolin, lspinorb, domag, & + npol, nspin, nspin_lsda, nspin_mag, nspin_gga, current_spin ) + !------------------------------------------------------------------------ + ! + ! Set various spin-related variables + ! + LOGICAL, INTENT(IN) :: lsda, noncolin, lspinorb, domag + INTEGER, INTENT(OUT) :: npol, nspin, nspin_lsda, nspin_mag, nspin_gga + INTEGER, INTENT(OUT) :: current_spin + ! + IF ( lsda ) THEN + ! + ! ... wavefunctions have up and down spin + ! + npol = 1 + nspin = 2 + nspin_mag = 2 + nspin_lsda = 2 + nspin_gga = 2 + current_spin = -1 + ELSE IF (nspin==4) THEN + ! + ! ... wavefunctions are spinors with 2 components + ! + npol = 2 + nspin = 4 + nspin_lsda = 1 + IF (domag) THEN + nspin_gga = 2 + nspin_mag = 4 + ELSE + nspin_gga = 1 + nspin_mag = 1 + ENDIF + current_spin = 1 + ELSE + ! + ! ... wavefunctions are scalars + ! + npol = 1 + nspin = 1 + nspin_mag = 1 + nspin_lsda = 1 + nspin_gga = 1 + current_spin = 1 + END IF + ! +END SUBROUTINE set_spin_vars diff --git a/PW/src/setup.f90 b/PW/src/setup.f90 index b748e5226c..3bb48c4f6a 100644 --- a/PW/src/setup.f90 +++ b/PW/src/setup.f90 @@ -47,8 +47,6 @@ SUBROUTINE setup() ltetra, lxkcry, nkstot, & nelup, neldw, two_fermi_energies, & tot_charge, tot_magnetization - USE lsda_mod, ONLY : lsda, nspin, current_spin, isk, & - starting_magnetization USE ener, ONLY : ef, ef_up, ef_dw USE electrons_base, ONLY : set_nelup_neldw USE start_k, ONLY : nks_start, xk_start, wk_start, & @@ -72,6 +70,8 @@ SUBROUTINE setup() USE fixed_occ, ONLY : f_inp, tfixed_occ, one_atom_occupations USE mp_pools, ONLY : kunit USE mp_bands, ONLY : intra_bgrp_comm, nyfft + USE lsda_mod, ONLY : lsda, nspin, current_spin, isk, & + starting_magnetization USE spin_orb, ONLY : lspinorb, domag USE noncollin_module, ONLY : noncolin, npol, m_loc, i_cons, & angle1, angle2, bfield, ux, nspin_lsda, & @@ -177,9 +177,24 @@ SUBROUTINE setup() ! ! ... magnetism-related quantities ! - ALLOCATE( m_loc( 3, nat ) ) + ! ... Set the domag variable to make a spin-orbit calculation with zero + ! ... magnetization + ! + IF ( lspinorb ) THEN + domag = ANY ( ABS( starting_magnetization(1:ntyp) ) > 1.D-6 ) + ELSE + domag = .TRUE. + END IF + ! + ! Set the different spin indices + ! + CALL set_spin_vars( lsda, noncolin, lspinorb, domag, & + npol, nspin, nspin_lsda, nspin_mag, nspin_gga, current_spin ) + ! ! time reversal operation is set up to 0 by default t_rev = 0 + ! + ALLOCATE( m_loc( 3, nat ) ) IF ( noncolin ) THEN ! ! gamma_only and noncollinear not allowed @@ -187,23 +202,6 @@ SUBROUTINE setup() if (gamma_only) call errore('setup', & 'gamma_only and noncolin not allowed',1) ! - ! ... wavefunctions are spinors with 2 components - ! - npol = 2 - ! - ! ... Set the domag variable to make a spin-orbit calculation with zero - ! ... magnetization - ! - IF ( lspinorb ) THEN - ! - domag = ANY ( ABS( starting_magnetization(1:ntyp) ) > 1.D-6 ) - ! - ELSE - ! - domag = .TRUE. - ! - END IF - ! DO na = 1, nat ! m_loc(1,na) = starting_magnetization(ityp(na)) * & @@ -220,47 +218,31 @@ SUBROUTINE setup() if (dft_is_gradient()) call compute_ux(m_loc,ux,nat) ! ELSE - ! - ! ... wavefunctions are scalars ! IF (lspinorb) CALL errore( 'setup ', & 'spin orbit requires a non collinear calculation', 1 ) - npol = 1 - ! ! IF ( i_cons == 1) then do na=1,nat m_loc(1,na) = starting_magnetization(ityp(na)) end do end if - IF ( i_cons /= 0 .AND. nspin ==1) & + IF ( i_cons /= 0 .AND. nspin==1 ) & CALL errore( 'setup', 'this i_cons requires a magnetic calculation ', 1 ) IF ( i_cons /= 0 .AND. i_cons /= 1 ) & - CALL errore( 'setup', 'this i_cons requires a non colinear run', 1 ) + CALL errore( 'setup', 'this i_cons requires a non colinear run', 1 ) + ! END IF ! - ! Set the different spin indices - ! - nspin_mag = nspin - nspin_lsda = nspin - nspin_gga = nspin - IF (nspin==4) THEN - nspin_lsda=1 - IF (domag) THEN - nspin_gga=2 - ELSE - nspin_gga=1 - nspin_mag=1 - ENDIF - ENDIF - ! ! ... if this is not a spin-orbit calculation, all spin-orbit pseudopotentials ! ... are transformed into standard pseudopotentials ! - IF ( lspinorb .AND. ALL ( .NOT. upf(:)%has_so ) ) & - CALL infomsg ('setup','At least one non s.o. pseudo') - ! - IF ( .NOT. lspinorb ) CALL average_pp ( ntyp ) + IF ( lspinorb ) THEN + IF ( ALL ( .NOT. upf(:)%has_so ) ) & + CALL infomsg ('setup','At least one non s.o. pseudo') + ELSE + CALL average_pp ( ntyp ) + END IF ! ! ... If the occupations are from input, check the consistency with the ! ... number of electrons @@ -352,7 +334,9 @@ SUBROUTINE setup() ! ... for subsequent steps ethr is automatically updated in electrons ! IF ( nat==0 ) THEN + ! ethr=1.0D-8 + ! ELSE IF ( .NOT. lscf ) THEN ! IF ( ethr == 0.D0 ) ethr = 0.1D0 * MIN( 1.D-2, tr2 / nelec ) From cebdeb95ce039a67a3d83280c7592d4243439857 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Mon, 15 Jul 2019 10:14:45 +0200 Subject: [PATCH 66/95] One more fix to recent commits Apparently, setting smearing to "Gaussian" instead of "gaussian" causes an obscure crash in FoX because the code expects "gaussian" in another well hidden place and does not recognizes "Gaussian". Oh well. --- PW/src/set_occupations.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PW/src/set_occupations.f90 b/PW/src/set_occupations.f90 index 9e91366ed8..6754588a7f 100644 --- a/PW/src/set_occupations.f90 +++ b/PW/src/set_occupations.f90 @@ -44,7 +44,7 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & SELECT CASE ( trim( smearing ) ) CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) ngauss = 0 - smearing = 'Gaussian' + smearing = 'gaussian' CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) ngauss = 1 smearing = 'Methfessel-Paxton' From 3d1fdbf80fc1e4456265563f5d61f42a6f732be3 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Mon, 15 Jul 2019 10:43:59 +0200 Subject: [PATCH 67/95] Even more remarkable: Marzari-Vanderbilt is ok, methfessel-paxton without capitals .. --- PW/src/set_occupations.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PW/src/set_occupations.f90 b/PW/src/set_occupations.f90 index 6754588a7f..f16612c99e 100644 --- a/PW/src/set_occupations.f90 +++ b/PW/src/set_occupations.f90 @@ -47,7 +47,7 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & smearing = 'gaussian' CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) ngauss = 1 - smearing = 'Methfessel-Paxton' + smearing = 'methfessel-Paxton' CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') ngauss = -1 smearing = 'Marzari-Vanderbilt' From 79732989fe7e11d6668883d6881f3582fa65cba9 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Mon, 15 Jul 2019 10:44:56 +0200 Subject: [PATCH 68/95] Oops ... --- PW/src/set_occupations.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PW/src/set_occupations.f90 b/PW/src/set_occupations.f90 index f16612c99e..4e621460b8 100644 --- a/PW/src/set_occupations.f90 +++ b/PW/src/set_occupations.f90 @@ -47,7 +47,7 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & smearing = 'gaussian' CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) ngauss = 1 - smearing = 'methfessel-Paxton' + smearing = 'methfessel-paxton' CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') ngauss = -1 smearing = 'Marzari-Vanderbilt' From e76af65d8330cf24d202c193882f82b4619735d5 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Mon, 15 Jul 2019 16:44:19 +0200 Subject: [PATCH 69/95] Cleanup Both "printable" and "writable to xml" versions of the "smearing" variable are computed in the same place (set_occupancies.f90) --- Modules/qexsd_input.f90 | 29 ++-------------------- PW/src/pw_init_qexsd_input.f90 | 16 +++++++----- PW/src/pw_restart_new.f90 | 7 ++++-- PW/src/set_occupations.f90 | 45 ++++++++++++++++++++++++++++------ 4 files changed, 54 insertions(+), 43 deletions(-) diff --git a/Modules/qexsd_input.f90 b/Modules/qexsd_input.f90 index 8555c617ca..35bdd07896 100644 --- a/Modules/qexsd_input.f90 +++ b/Modules/qexsd_input.f90 @@ -103,7 +103,6 @@ SUBROUTINE qexsd_init_bands(obj, nbnd, smearing, degauss, occupations, tot_charg REAL(DP),DIMENSION(:),OPTIONAL,INTENT(IN) :: input_occupations, input_occupations_minority REAL(DP),OPTIONAL,INTENT(IN) :: tot_mag, tot_charge ! - CHARACTER(25) :: smearing_local INTEGER :: spin_degeneracy, inpOcc_size = 0 CHARACTER(LEN=*),PARAMETER :: TAGNAME="bands" TYPE(smearing_type),POINTER :: smearing_obj => NULL() @@ -114,17 +113,7 @@ SUBROUTINE qexsd_init_bands(obj, nbnd, smearing, degauss, occupations, tot_charg ! IF (TRIM(occupations) .EQ. "smearing") THEN ALLOCATE(smearing_obj) - SELECT CASE (TRIM (smearing)) - CASE ("gaussian", "gauss") - smearing_local="gaussian" - CASE ('methfessel-paxton', 'm-p', 'mp') - smearing_local="mp" - CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv','Marzari-Vanderbilt') - smearing_local="mv" - CASE ('fermi-dirac', 'f-d', 'fd') - smearing_local="fd" - END SELECT - CALL qes_init (smearing_obj,"smearing",degauss=degauss,smearing=smearing_local) + CALL qes_init (smearing_obj,"smearing",degauss=degauss,smearing=smearing) END IF CALL qes_init (occup_obj, "occupations", occupations = TRIM(occupations)) ! @@ -661,21 +650,7 @@ SUBROUTINE qexsd_init_smearing(obj, smearing, degauss) CHARACTER(LEN = * ), INTENT(IN) :: smearing REAL(DP),INTENT(IN) :: degauss ! - CHARACTER(LEN=256) :: smearing_local - - SELECT CASE (TRIM (smearing)) - CASE ("gaussian", "gauss") - smearing_local="gaussian" - CASE ('methfessel-paxton', 'm-p', 'mp') - smearing_local="mp" - CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt') - smearing_local="mv" - CASE ('fermi-dirac', 'f-d', 'fd') - smearing_local="fd" - CASE default - smearing_local='not set' - END SELECT - CALL qes_init (obj,"smearing",degauss=degauss,smearing=smearing_local) + CALL qes_init (obj,"smearing",degauss=degauss,smearing=smearing) ! END SUBROUTINE qexsd_init_smearing !-------------------------------------------------------------------------------------------- diff --git a/PW/src/pw_init_qexsd_input.f90 b/PW/src/pw_init_qexsd_input.f90 index fc3a435e3d..d319433bea 100644 --- a/PW/src/pw_init_qexsd_input.f90 +++ b/PW/src/pw_init_qexsd_input.f90 @@ -92,6 +92,8 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) INTEGER,EXTERNAL :: set_hubbard_l INTEGER :: lung,l CHARACTER,EXTERNAL :: capital + CHARACTER(LEN=8), EXTERNAL :: schema_smearing + CHARACTER(LEN=8) :: smearing_loc CHARACTER(len=20) :: dft_shortname CHARACTER(len=25) :: dft_longname CHARACTER(LEN=80),TARGET :: vdw_corr_, vdw_nonlocc_ @@ -343,20 +345,22 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) nbnd_tg = nbnd nbnd_pt => nbnd_tg END IF + smearing_loc = schema_smearing(smearing) IF (tf_inp) THEN SELECT CASE (ip_nspin) CASE (2) - CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing, degauss, ip_occupations, tot_charge, ip_nspin, & - input_occupations=f_inp(:,1),input_occupations_minority=f_inp(:,2)) + CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing_loc, degauss, & + ip_occupations, tot_charge, ip_nspin, & + input_occupations=f_inp(:,1),input_occupations_minority=f_inp(:,2)) CASE default - CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing, degauss, ip_occupations, tot_charge, ip_nspin, & - input_occupations=f_inp(:,1) ) + CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing_loc, degauss, & + ip_occupations, tot_charge, ip_nspin, input_occupations=f_inp(:,1) ) END SELECT ELSE IF ( tot_magnetization .LT. 0 ) THEN - CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing, degauss, ip_occupations, tot_charge, ip_nspin) + CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing_loc, degauss, ip_occupations, tot_charge, ip_nspin) ELSE - CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing, degauss, ip_occupations, tot_charge, ip_nspin, & + CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing_loc, degauss, ip_occupations, tot_charge, ip_nspin, & TOT_MAG = tot_magnetization) END IF END IF diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index f799d82898..92208dab89 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -144,6 +144,8 @@ SUBROUTINE pw_write_schema( only_init, wf_collect ) ! CHARACTER(LEN=20) :: dft_name CHARACTER(LEN=256) :: dirname + CHARACTER(LEN=8) :: smearing_loc + CHARACTER(LEN=8), EXTERNAL :: schema_smearing INTEGER :: i, ig, ngg, ipol INTEGER :: npwx_g, ispin, inlc INTEGER, ALLOCATABLE :: ngk_g(:) @@ -535,8 +537,9 @@ SUBROUTINE pw_write_schema( only_init, wf_collect ) IF ( lgauss ) THEN IF (TRIM(qexsd_input_obj%tagname) == 'input') THEN smear_obj = qexsd_input_obj%bands%smearing - ELSE - CALL qexsd_init_smearing(smear_obj, smearing, degauss) + ELSE + smearing_loc = schema_smearing( smearing ) + CALL qexsd_init_smearing(smear_obj, smearing_loc, degauss) END IF smear_obj_ptr => smear_obj END IF diff --git a/PW/src/set_occupations.f90 b/PW/src/set_occupations.f90 index 4e621460b8..e3c9b4b3e8 100644 --- a/PW/src/set_occupations.f90 +++ b/PW/src/set_occupations.f90 @@ -9,12 +9,16 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & lfixed, ltetra, tetra_type, lgauss, ngauss ) !------------------------------------------------------------------------ + ! Sets variables describind occupations + ! USE kinds, ONLY: dp ! IMPLICIT NONE ! CHARACTER(LEN=*), INTENT(IN) :: occupations + ! On output smearing is converted to a "standard" value for printout CHARACTER(LEN=*), INTENT(INOUT) :: smearing + ! On output degauss is set to 0 if smearing is not used REAL(dp), INTENT(INOUT) :: degauss LOGICAL, INTENT(OUT) :: lfixed, lgauss, ltetra INTEGER, INTENT(OUT) :: tetra_type, ngauss @@ -24,7 +28,7 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & tetra_type = 0 lgauss = .FALSE. ngauss = 0 - + ! SELECT CASE( trim( occupations ) ) CASE( 'fixed' ) ! @@ -44,10 +48,10 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & SELECT CASE ( trim( smearing ) ) CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) ngauss = 0 - smearing = 'gaussian' + smearing = 'Gaussian' CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) ngauss = 1 - smearing = 'methfessel-paxton' + smearing = 'Methfessel-Paxton' CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') ngauss = -1 smearing = 'Marzari-Vanderbilt' @@ -64,28 +68,27 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & ltetra = .true. tetra_type = 0 smearing = 'none' - ! + degauss = 0.0_dp ! CASE( 'tetrahedra_lin', 'tetrahedra-lin') ! ltetra = .true. tetra_type = 1 smearing = 'none' - ! + degauss = 0.0_dp ! CASE('tetrahedra_opt', 'tetrahedra-opt') ! ltetra = .true. tetra_type = 2 smearing = 'none' - ! + degauss = 0.0_dp ! CASE( 'from_input' ) ! - ngauss = 0 lfixed = .true. smearing = 'none' - ! + degauss = 0.0_dp ! CASE DEFAULT ! @@ -95,3 +98,29 @@ SUBROUTINE set_occupations( occupations, smearing, degauss, & END SELECT ! END SUBROUTINE set_occupations +!--------------------------------------------------------------------------- +FUNCTION schema_smearing( smearing ) + !------------------------------------------------------------------------ + ! Converts smearing to the standard value needed in xml file + ! + USE kinds, ONLY: dp + ! + IMPLICIT NONE + ! + CHARACTER(LEN=*), INTENT(IN) :: smearing + CHARACTER(LEN=8) :: schema_smearing + ! + SELECT CASE ( trim( smearing ) ) + CASE ( 'gaussian', 'gauss', 'Gaussian', 'Gauss' ) + schema_smearing = 'gaussian' + CASE ( 'methfessel-paxton', 'm-p', 'mp', 'Methfessel-Paxton', 'M-P', 'MP' ) + schema_smearing = 'mp' + CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv', 'Marzari-Vanderbilt', 'M-V', 'MV') + schema_smearing = 'mv' + CASE ( 'fermi-dirac', 'f-d', 'fd', 'Fermi-Dirac', 'F-D', 'FD') + schema_smearing = 'fd' + CASE DEFAULT + schema_smearing = TRIM(smearing(1:8)) + END SELECT + ! +END FUNCTION schema_smearing From 5787b68afdcd13c1f39ee5a6be81b5902579b8a6 Mon Sep 17 00:00:00 2001 From: giannozz Date: Mon, 15 Jul 2019 18:29:50 +0200 Subject: [PATCH 70/95] More input_paraneters removal --- CPV/src/cp_restart_new.f90 | 3 ++- Modules/qexsd.f90 | 11 ++++++----- PP/src/write_hamiltonians.f90 | 4 ++-- PW/src/pw_restart_new.f90 | 4 +++- PW/src/set_occupations.f90 | 4 ++-- 5 files changed, 15 insertions(+), 11 deletions(-) diff --git a/CPV/src/cp_restart_new.f90 b/CPV/src/cp_restart_new.f90 index b77eb5825f..efb575413c 100644 --- a/CPV/src/cp_restart_new.f90 +++ b/CPV/src/cp_restart_new.f90 @@ -270,7 +270,8 @@ SUBROUTINE cp_writefile( ndw, ascii, nfi, simtime, acc, nk, xk, & ! ... HEADER !------------------------------------------------------------------------------- ! - CALL qexsd_openschema(TRIM( dirname ) // TRIM( xmlpun_schema ), 'CPV' ) + CALL qexsd_openschema(TRIM( dirname ) // TRIM( xmlpun_schema ), 'CPV',& + title) output_obj%tagname="output" output_obj%lwrite = .TRUE. !------------------------------------------------------------------------------- diff --git a/Modules/qexsd.f90 b/Modules/qexsd.f90 index 24f5a7caa1..0373a9424b 100644 --- a/Modules/qexsd.f90 +++ b/Modules/qexsd.f90 @@ -19,7 +19,7 @@ MODULE qexsd_module ! Modified by Simone Ziraldo (2013). ! USE kinds, ONLY : DP - USE input_parameters, ONLY : input_xml_schema_file, title + USE input_parameters, ONLY : input_xml_schema_file USE mp_world, ONLY : nproc USE mp_images, ONLY : nimage,nproc_image USE mp_pools, ONLY : npool @@ -141,13 +141,13 @@ END FUNCTION check_file_exst ! ! !------------------------------------------------------------------------ - SUBROUTINE qexsd_openschema( filename , prog) + SUBROUTINE qexsd_openschema(filename, prog, title) !------------------------------------------------------------------------ ! USE FoX_wxml, ONLY: xml_OpenFile, xml_DeclareNamespace, xml_NewElement, xml_addAttribute, xml_addComment IMPLICIT NONE ! - CHARACTER(len=*), INTENT(IN) :: filename, prog + CHARACTER(len=*), INTENT(IN) :: filename, prog, title CHARACTER(len=16) :: subname = 'qexsd_openschema' INTEGER :: ierr, len_steps, i_step ! @@ -169,7 +169,7 @@ SUBROUTINE qexsd_openschema( filename , prog) ! the input file is mandatory to have a validating schema ! here an error should be issued, instead ! - CALL qexsd_init_general_info(general_info, prog(1:2) ) + CALL qexsd_init_general_info(general_info, prog(1:2), title ) CALL qes_write (qexsd_xf,general_info) CALL qes_reset (general_info) ! @@ -197,12 +197,13 @@ END SUBROUTINE qexsd_openschema ! ! !--------------------------------------------------------------------------------------- - SUBROUTINE qexsd_init_general_info(obj, prog ) + SUBROUTINE qexsd_init_general_info(obj, prog, title ) !--------------------------------------------------------------------------------------- IMPLICIT NONE ! TYPE( general_info_type ) :: obj CHARACTER(LEN=*),INTENT(IN) :: prog + CHARACTER(LEN=*),INTENT(IN) :: title CHARACTER(LEN=*),PARAMETER :: TAGNAME="general_info" TYPE( creator_type ) :: creator_obj TYPE( created_type ) :: created_obj diff --git a/PP/src/write_hamiltonians.f90 b/PP/src/write_hamiltonians.f90 index 5d10108760..c9b01b1487 100644 --- a/PP/src/write_hamiltonians.f90 +++ b/PP/src/write_hamiltonians.f90 @@ -72,7 +72,7 @@ SUBROUTINE write_hamiltonian_amulet(nwan,hamk,hash,iunhamilt) USE constants, ONLY : rytoev USE klist, ONLY: nks, wk, xk USE lsda_mod, ONLY : nspin - USE input_parameters, ONLY : title + USE run_info, ONLY : title USE global_version, ONLY : version_number IMPLICIT NONE @@ -161,7 +161,7 @@ SUBROUTINE write_systemdata_amulet(hash,nelec,iunsystem) USE constants, ONLY : rytoev USE klist, ONLY: nks, wk, xk USE lsda_mod, ONLY : nspin - USE input_parameters, ONLY : title + USE run_info, ONLY : title USE ions_base, ONLY : nat, atm, tau, ityp USE cell_base, ONLY : alat, at USE ener, ONLY : ef diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 92208dab89..08b37153f3 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -137,6 +137,7 @@ SUBROUTINE pw_write_schema( only_init, wf_collect ) USE Coul_cut_2D, ONLY : do_cutoff_2D USE esm, ONLY : do_comp_esm USE martyna_tuckerman, ONLY : do_comp_mt + USE run_info, ONLY : title ! IMPLICIT NONE ! @@ -234,7 +235,8 @@ SUBROUTINE pw_write_schema( only_init, wf_collect ) ! ... HEADER !------------------------------------------------------------------------------- ! - CALL qexsd_openschema(TRIM( dirname ) // TRIM( xmlpun_schema ), 'PWSCF' ) + CALL qexsd_openschema(TRIM( dirname ) // TRIM( xmlpun_schema ), & + 'PWSCF', title ) output%tagname="output" output%lwrite = .TRUE. output%lread = .TRUE. diff --git a/PW/src/set_occupations.f90 b/PW/src/set_occupations.f90 index e3c9b4b3e8..a9c71b4011 100644 --- a/PW/src/set_occupations.f90 +++ b/PW/src/set_occupations.f90 @@ -7,9 +7,9 @@ ! !--------------------------------------------------------------------------- SUBROUTINE set_occupations( occupations, smearing, degauss, & - lfixed, ltetra, tetra_type, lgauss, ngauss ) + lfixed, ltetra, tetra_type, lgauss, ngauss ) !------------------------------------------------------------------------ - ! Sets variables describind occupations + ! Set variables describing occupations ! USE kinds, ONLY: dp ! From ef3579c992bbf98034b8263e2e521127468756ae Mon Sep 17 00:00:00 2001 From: Pietro Delugas Date: Tue, 16 Jul 2019 08:28:34 +0000 Subject: [PATCH 71/95] fixing configure for hdf5 --- install/configure | 32 ++++++++++++++++---------------- install/m4/x_ac_qe_hdf5.m4 | 16 +++------------- 2 files changed, 19 insertions(+), 29 deletions(-) diff --git a/install/configure b/install/configure index 76a7e8c95a..4182859d30 100755 --- a/install/configure +++ b/install/configure @@ -720,6 +720,7 @@ infodir docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir @@ -815,6 +816,7 @@ datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' @@ -1067,6 +1069,15 @@ do | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1204,7 +1215,7 @@ fi for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1357,6 +1368,7 @@ Fine tuning of the installation directories: --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] @@ -9627,13 +9639,7 @@ fi if test "$have_hdf5" -eq 1; then version_num=`grep "HDF5 Version" $with_hdf5_path/lib/libhdf5.settings | awk -F ':' '{print $2}'` version_ok=`echo $version_num | awk -F '.' '{print (($2 >= 10) || ( ($2 == 8) && ($3 >= 16)))}'` - if test $version_ok -gt 0; then - if test $version_third_ok -eq 0; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** HDF5 library rejected; version must be >= 1.8.16" >&5 -$as_echo "$as_me: WARNING: *** HDF5 library rejected; version must be >= 1.8.16" >&2;}; - have_hdf5=0; - fi - else + if test $version_ok -le 0; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** HDF5 version must be newer equal to 1.8.16" >&5 $as_echo "$as_me: WARNING: *** HDF5 version must be newer equal to 1.8.16" >&2;}; have_hdf5=0; @@ -9812,14 +9818,8 @@ fi fi if test "$have_hdf5" -eq 1; then version_num=`grep "HDF5 Version" $with_hdf5_path/lib/libhdf5.settings | awk -F ':' '{print $2}'` - version_ok=`echo $version_num | awk -F '.' '{print (($2 => 10) || ( ($2 == 8) && ($3 >= 16)))}'` - if test $version_sec_ok -gt 0; then - if test $version_third_ok -eq 0; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** HDF5 library rejected; version must be >= 1.8.16" >&5 -$as_echo "$as_me: WARNING: *** HDF5 library rejected; version must be >= 1.8.16" >&2;}; - have_hdf5=0; - fi - else + version_ok=`echo $version_num | awk -F '.' '{print (($2 >= 10) || ( ($2 == 8) && ($3 >= 16)))}'` + if test $version_ok -le 0; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** HDF5 version must be newer equal to 1.8.16" >&5 $as_echo "$as_me: WARNING: *** HDF5 version must be newer equal to 1.8.16" >&2;}; have_hdf5=0; diff --git a/install/m4/x_ac_qe_hdf5.m4 b/install/m4/x_ac_qe_hdf5.m4 index f0ab3d4ba1..ab0e9da4e3 100644 --- a/install/m4/x_ac_qe_hdf5.m4 +++ b/install/m4/x_ac_qe_hdf5.m4 @@ -78,12 +78,7 @@ if test "$use_parallel" -ne 0; then if test "$have_hdf5" -eq 1; then version_num=`grep "HDF5 Version" $with_hdf5_path/lib/libhdf5.settings | awk -F ':' '{print @S|@2}'` version_ok=`echo $version_num | awk -F '.' '{print ((@S|@2 >= 10) || ( (@S|@2 == 8) && (@S|@3 >= 16)))}'` - if test $version_ok -gt 0; then - if test $version_third_ok -eq 0; then - AC_MSG_WARN([*** HDF5 library rejected; version must be >= 1.8.16]); - have_hdf5=0; - fi - else + if test $version_ok -le 0; then AC_MSG_WARN([*** HDF5 version must be newer equal to 1.8.16]); have_hdf5=0; fi @@ -162,13 +157,8 @@ else fi if test "$have_hdf5" -eq 1; then version_num=`grep "HDF5 Version" $with_hdf5_path/lib/libhdf5.settings | awk -F ':' '{print @S|@2}'` - version_ok=`echo $version_num | awk -F '.' '{print ((@S|@2 => 10) || ( (@S|@2 == 8) && (@S|@3 >= 16)))}'` - if test $version_sec_ok -gt 0; then - if test $version_third_ok -eq 0; then - AC_MSG_WARN([*** HDF5 library rejected; version must be >= 1.8.16]); - have_hdf5=0; - fi - else + version_ok=`echo $version_num | awk -F '.' '{print ((@S|@2 >= 10) || ( (@S|@2 == 8) && (@S|@3 >= 16)))}'` + if test $version_ok -le 0; then AC_MSG_WARN([*** HDF5 version must be newer equal to 1.8.16]); have_hdf5=0; fi From 2fd4fe3e19de4a1e1e189e9af8a2e0d84c548d06 Mon Sep 17 00:00:00 2001 From: giannozz Date: Tue, 16 Jul 2019 15:35:33 +0200 Subject: [PATCH 72/95] Yet Another Dumb Mistake --- PW/src/set_spin_vars.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PW/src/set_spin_vars.f90 b/PW/src/set_spin_vars.f90 index da55dd785f..56d323e32b 100644 --- a/PW/src/set_spin_vars.f90 +++ b/PW/src/set_spin_vars.f90 @@ -26,7 +26,7 @@ SUBROUTINE set_spin_vars( lsda, noncolin, lspinorb, domag, & nspin_lsda = 2 nspin_gga = 2 current_spin = -1 - ELSE IF (nspin==4) THEN + ELSE IF ( noncolin ) THEN ! ! ... wavefunctions are spinors with 2 components ! From 3143fe1f3fb1062fbc7aed9d61456aa190dacea9 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Tue, 16 Jul 2019 16:48:55 +0000 Subject: [PATCH 73/95] Missing initialization of arrays used in computation of dV_xc/d\rho might cause strange crashes in spin-polarized phonon calculations. In spite of a recent extensive review, the phonon makefile did not have all needed dependencies in place: changes to Modules/ were ignored by "make ph" --- Modules/dmxc_drivers.f90 | 2 ++ PHonon/PH/Makefile | 14 +++++++------- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/Modules/dmxc_drivers.f90 b/Modules/dmxc_drivers.f90 index 6bbcf0e34b..a410cd6a7c 100644 --- a/Modules/dmxc_drivers.f90 +++ b/Modules/dmxc_drivers.f90 @@ -407,6 +407,8 @@ SUBROUTINE dmxc_lsda( length, rho_in, dmuxc ) ! ! ... THRESHOLD STUFF AND dr(:) dr(:) = 0.0_DP + zeta(:) = 0.0_dp + zeta_eff(:) = 0.0_dp DO ir = 1, length IF (rhotot(ir) > small) THEN zeta_s = (rho_in(ir,1) - rho_in(ir,2)) / rhotot(ir) diff --git a/PHonon/PH/Makefile b/PHonon/PH/Makefile index 0fd3bf8292..fd737ad9ad 100644 --- a/PHonon/PH/Makefile +++ b/PHonon/PH/Makefile @@ -204,38 +204,38 @@ all : tldeps libs-ph ph.x dynmat.x matdyn.x q2r.x q2trans.x q2trans_fd.x lambda. libs-ph : libph.a libphaux.a -ph.x : phonon.o libph.a $(PWOBJS) $(LRMODS) $(LIBOBJS) +ph.x : phonon.o libph.a $(PWOBJS) $(LRMODS) $(QEMODS) $(LIBOBJS) $(LD) $(LDFLAGS) -o $@ phonon.o libph.a \ $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS) $(QELIBS) - ( cd ../../bin ; ln -fs ../PHonon/PH/ph.x . ) -dynmat.x : dynmat.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(MODULES) $(LIBOBJS) +dynmat.x : dynmat.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(QEMODS) $(LIBOBJS) $(LD) $(LDFLAGS) -o $@ dynmat.o libphaux.a libph.a \ $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS) $(QELIBS) - ( cd ../../bin ; ln -fs ../PHonon/PH/$@ . ) -matdyn.x : matdyn.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(MODULES) $(LIBOBJS) +matdyn.x : matdyn.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(QEMODS) $(LIBOBJS) $(LD) $(LDFLAGS) -o $@ matdyn.o libphaux.a libph.a \ $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS) $(QELIBS) - ( cd ../../bin ; ln -fs ../PHonon/PH/$@ . ) -q2r.x : q2r.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(MODULES) $(LIBOBJS) +q2r.x : q2r.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(QEMODS) $(LIBOBJS) $(LD) $(LDFLAGS) -o $@ q2r.o libphaux.a libph.a \ $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS) $(QELIBS) - ( cd ../../bin ; ln -fs ../PHonon/PH/$@ . ) -q2trans.x : q2trans.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(MODULES) $(LIBOBJS) +q2trans.x : q2trans.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(QEMODS) $(LIBOBJS) $(LD) $(LDFLAGS) -o $@ q2trans.o libphaux.a libph.a \ $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS) $(QELIBS) - ( cd ../../bin ; ln -fs ../PHonon/PH/$@ . ) -q2trans_fd.x : q2trans_fd.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(MODULES) $(LIBOBJS) +q2trans_fd.x : q2trans_fd.o libphaux.a libph.a $(PWOBJS) $(LRMODS) $(QEMODS) $(LIBOBJS) $(LD) $(LDFLAGS) -o $@ q2trans_fd.o libphaux.a libph.a \ $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS) $(QELIBS) - ( cd ../../bin ; ln -fs ../PHonon/PH/$@ . ) -q2qstar.x : q2qstar.o libph.a $(PWOBJS) $(LRMODS) $(MODULES) $(LIBOBJS) +q2qstar.x : q2qstar.o libph.a $(PWOBJS) $(LRMODS) $(QEMODS) $(LIBOBJS) $(LD) $(LDFLAGS) -o $@ q2qstar.o libph.a \ $(LRMODS) $(PWOBJS) $(QEMODS) $(LIBOBJS) $(QELIBS) - ( cd ../../bin ; ln -fs ../PHonon/PH/$@ . ) From ac9d5fb79aee936ff0bf4b8251ee99fcec58dced Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Tue, 16 Jul 2019 16:52:43 +0000 Subject: [PATCH 74/95] Workaround for bogus and not-so-bogus out-of-bound errors in function "matching". Not sure the fix is right, but it looks less wrong than before --- Modules/funct.f90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/Modules/funct.f90 b/Modules/funct.f90 index d22dcc57ec..13c3313715 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -799,15 +799,19 @@ FUNCTION matching( fslot, dft, n, name, its_libxc ) its_libxc = .FALSE. matching = notset ! - length = LEN( dft ) + length = LEN_TRIM( dft ) ! ii = 0 ! DO i = 1, length ii = ii+1 - IF (ii == length-1) EXIT + IF (ii >= length-1) EXIT ! - IF ( ii==1 .OR. (ii>1 .AND. dft(ii-1:ii-1).EQ.' ') ) THEN + IF ( ii==1 ) THEN + DO j = 1, length-ii + IF (dft(ii+j:ii+j) .EQ. ' ') EXIT + ENDDO + ELSE IF ( dft(ii-1:ii-1).EQ.' ' ) THEN DO j = 1, length-ii IF (dft(ii+j:ii+j) .EQ. ' ') EXIT ENDDO From 28fb9455c135d4495c46a69fc85e0f7b9245427a Mon Sep 17 00:00:00 2001 From: Samuel Ponce Date: Wed, 17 Jul 2019 11:46:47 +0100 Subject: [PATCH 75/95] Debug of USPP By R. Margine. --- EPW/src/adddvscf2.f90 | 2 +- EPW/src/dvanqq2.f90 | 48 +++++++---- EPW/src/dvqpsi_us3.f90 | 5 +- EPW/src/dvqpsi_us_only3.f90 | 144 ++++++++++++++++---------------- EPW/src/elphon_shuffle_wrap.f90 | 33 +++++--- EPW/src/ephwann_shuffle.f90 | 4 +- EPW/src/ephwann_shuffle_mem.f90 | 2 +- EPW/src/epw_init.f90 | 23 ++--- EPW/src/epw_readin.f90 | 1 - EPW/src/newdq2.f90 | 19 +++-- EPW/src/pw2wan90epw.f90 | 4 +- 11 files changed, 158 insertions(+), 127 deletions(-) diff --git a/EPW/src/adddvscf2.f90 b/EPW/src/adddvscf2.f90 index 39fb3ab6f5..d159af7aa4 100644 --- a/EPW/src/adddvscf2.f90 +++ b/EPW/src/adddvscf2.f90 @@ -73,7 +73,7 @@ SUBROUTINE adddvscf2( ipert, ik ) COMPLEX(kind=DP) :: sum_nc(npol) !! auxiliary sum variable non-collinear case ! - IF ( .NOT. okvan) RETURN + IF (.NOT. okvan) RETURN ! CALL start_clock('adddvscf2') ! diff --git a/EPW/src/dvanqq2.f90 b/EPW/src/dvanqq2.f90 index 2b63732413..bf84723497 100644 --- a/EPW/src/dvanqq2.f90 +++ b/EPW/src/dvanqq2.f90 @@ -94,7 +94,7 @@ SUBROUTINE dvanqq2 !! e^{-i q * \tau} * conjg(e^{-i q * \tau}) COMPLEX(kind=DP) :: fact1 !! -i * omega - COMPLEX(kind=DP), EXTERNAL :: zdotc + COMPLEX(kind=DP), EXTERNAL :: ZDOTC !! the scalar product function COMPLEX(kind=DP), ALLOCATABLE :: aux1(:), aux2(:), & aux3(:), aux5(:), sk(:) @@ -105,7 +105,7 @@ SUBROUTINE dvanqq2 COMPLEX(kind=DP), POINTER :: qgmq(:) !! the augmentation function at q+G ! - IF ( .NOT. okvan) RETURN + IF (.NOT. okvan) RETURN ! CALL start_clock('dvanqq2') ! @@ -113,6 +113,7 @@ SUBROUTINE dvanqq2 int2(:,:,:,:,:) = czero int4(:,:,:,:,:) = czero int5(:,:,:,:,:) = czero + ! ALLOCATE ( sk(ngm) ) ALLOCATE ( aux1(ngm) ) ALLOCATE ( aux2(ngm) ) @@ -124,17 +125,32 @@ SUBROUTINE dvanqq2 ALLOCATE ( qgm(ngm)) ALLOCATE ( ylmk0(ngm, lmaxq * lmaxq) ) ALLOCATE ( ylmkq(ngm, lmaxq * lmaxq) ) + sk(:) = czero + aux1(:) = czero + aux2(:) = czero + aux3(:) = czero + aux5(:) = czero + qmodg(:) = zero + qmod(:) = zero + qgmq(:) = czero + qgm(:) = czero + ylmk0(:,:) = zero + ylmkq(:,:) = zero ! ! compute spherical harmonics ! CALL ylmr2( lmaxq * lmaxq, ngm, g, gg, ylmk0 ) + ! DO ig = 1, ngm qmodg(ig) = sqrt( gg(ig) ) ENDDO ! ALLOCATE ( qpg(3, ngm) ) + qpg(:,:) = zero + ! CALL setqmod( ngm, xq, g, qmod, qpg ) CALL ylmr2(lmaxq * lmaxq, ngm, qpg, qmod, ylmkq) + ! DEALLOCATE (qpg) DO ig = 1, ngm qmod(ig) = sqrt( qmod(ig) ) @@ -143,8 +159,10 @@ SUBROUTINE dvanqq2 ! we start by computing the FT of the effective potential ! ALLOCATE (veff(dfftp%nnr,nspin_mag)) + veff(:,:) = czero + ! DO is = 1, nspin_mag - IF (nspin_mag.ne.4 .or. is==1) THEN + IF (nspin_mag /= 4 .OR. is == 1) THEN DO ir = 1, dfftp%nnr veff(ir,is) = CMPLX(vltot(ir) + v%of_r(ir,is), zero, kind=DP) ENDDO @@ -200,7 +218,7 @@ SUBROUTINE dvanqq2 aux5(ig) = sk(ig) * ( g(ipol,ig) + xq(ipol) ) ENDDO int2(ih,jh,ipol,na,nb) = fact * fact1 * & - zdotc(ngm, aux1, 1, aux5, 1) + ZDOTC(ngm, aux1, 1, aux5, 1) ! DO jpol = 1, 3 IF (jpol >= ipol) THEN @@ -210,7 +228,7 @@ SUBROUTINE dvanqq2 ENDDO int5(ijh,ipol,jpol,na,nb) = & conjg(fact) * tpiba2 * omega * & - zdotc(ngm, aux3, 1, aux1, 1) + ZDOTC(ngm, aux3, 1, aux1, 1) ELSE int5(ijh,ipol,jpol,na,nb) = & int5(ijh,jpol,ipol,na,nb) @@ -232,14 +250,14 @@ SUBROUTINE dvanqq2 aux2(ig) = veff(dfftp%nl(ig),is) * g(ipol,ig) ENDDO int1(ih,jh,ipol,nb,is) = - fact1 * & - zdotc(ngm, aux1, 1, aux2, 1) + ZDOTC(ngm, aux1, 1, aux2, 1) DO jpol = 1, 3 IF (jpol >= ipol) THEN DO ig = 1, ngm aux3(ig) = aux2(ig) * g(jpol,ig) ENDDO int4(ijh,ipol,jpol,nb,is) = - tpiba2 * & - omega * zdotc(ngm, aux3, 1, aux1, 1) + omega * ZDOTC(ngm, aux3, 1, aux1, 1) ELSE int4(ijh,ipol,jpol,nb,is) = & int4(ijh,jpol,ipol,nb,is) @@ -304,14 +322,14 @@ SUBROUTINE dvanqq2 ENDIF ! !DBRM - !write(*,'(a,e20.12)') 'int1 = ', & - !SUM((REAL(REAL(int1(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int1(:,:,:,:,:))))**2) - !write(*,'(a,e20.12)') 'int2 = ', & - !SUM((REAL(REAL(int2(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int2(:,:,:,:,:))))**2) - !write(*,'(a,e20.12)') 'int4 = ', & - !SUM((REAL(REAL(int4(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int4(:,:,:,:,:))))**2) - !write(*,'(a,e20.12)') 'int5 = ', & - !SUM((REAL(REAL(int5(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int5(:,:,:,:,:))))**2) +! write(*,'(a,e20.12)') 'int1 = ', & +! SUM((REAL(REAL(int1(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int1(:,:,:,:,:))))**2) +! write(*,'(a,e20.12)') 'int2 = ', & +! SUM((REAL(REAL(int2(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int2(:,:,:,:,:))))**2) +! write(*,'(a,e20.12)') 'int4 = ', & +! SUM((REAL(REAL(int4(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int4(:,:,:,:,:))))**2) +! write(*,'(a,e20.12)') 'int5 = ', & +! SUM((REAL(REAL(int5(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int5(:,:,:,:,:))))**2) !END ! DEALLOCATE (sk) diff --git a/EPW/src/dvqpsi_us3.f90 b/EPW/src/dvqpsi_us3.f90 index b3280af19b..9be11a5ca6 100644 --- a/EPW/src/dvqpsi_us3.f90 +++ b/EPW/src/dvqpsi_us3.f90 @@ -175,13 +175,14 @@ SUBROUTINE dvqpsi_us3( ik, uact, addnlcc, xxkq, xq0, igk, igkq, npw, npwq ) ! CALL invfft('Rho', drhoc, dfftp) ! - IF ( .NOT. lsda) THEN + aux(:) = czero + IF (.NOT. lsda) THEN DO ir = 1, dfftp%nnr aux(ir) = drhoc(ir) * dmuxc(ir,1,1) ENDDO ELSE is = isk_loc(ik) - DO ir=1, dfftp%nnr + DO ir = 1, dfftp%nnr aux(ir) = drhoc(ir) * 0.5d0 * (dmuxc(ir, is, 1) + dmuxc(ir, is, 2)) ENDDO ENDIF diff --git a/EPW/src/dvqpsi_us_only3.f90 b/EPW/src/dvqpsi_us_only3.f90 index 2300e2f16f..1de6b13684 100644 --- a/EPW/src/dvqpsi_us_only3.f90 +++ b/EPW/src/dvqpsi_us_only3.f90 @@ -10,7 +10,7 @@ ! adapted from PH/dvqpsi_us_only (QE) ! !---------------------------------------------------------------------- - subroutine dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) + SUBROUTINE dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) !---------------------------------------------------------------------- !! !! This routine calculates dV_bare/dtau * psi for one perturbation @@ -35,7 +35,7 @@ subroutine dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) USE eqv, ONLY : dvpsi USE elph2, ONLY : lower_band, upper_band USE noncollin_module, ONLY : noncolin, npol - USE constants_epw, ONLY : czero, cone, eps12 + USE constants_epw, ONLY : czero, zero, cone, eps12 USE klist_epw, ONLY : isk_loc ! IMPLICIT NONE @@ -100,24 +100,24 @@ subroutine dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) ALLOCATE ( ps1_nc(nkb, npol, lower_band:upper_band) ) ALLOCATE ( ps2_nc(nkb, npol, lower_band:upper_band, 3) ) ALLOCATE ( deff_nc(nhm, nhm, nat, nspin) ) + ps1_nc(:,:,:) = czero + ps2_nc(:,:,:,:) = czero + deff_nc(:,:,:,:) = czero ELSE ALLOCATE ( ps1(nkb, lower_band:upper_band) ) ALLOCATE ( ps2(nkb, lower_band:upper_band, 3) ) ALLOCATE ( deff(nhm, nhm, nat) ) + ps1(:,:) = czero + ps2(:,:,:) = czero + deff(:,:,:) = zero ENDIF ALLOCATE ( aux(npwx) ) + aux(:) = czero + ! IF (lsda) current_spin = isk_loc(ik) ! ! we first compute the coefficients of the vectors ! - IF (noncolin) THEN - ps1_nc(:,:,:) = czero - ps2_nc(:,:,:,:) = czero - ELSE - ps1(:,:) = czero - ps2(:,:,:) = czero - ENDIF - ! DO ibnd = lower_band, upper_band IF (noncolin) THEN CALL compute_deff_nc( deff_nc, et(ibnd,ik) ) @@ -142,7 +142,7 @@ subroutine dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) DO js = 1, npol ijs = ijs + 1 ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & - deff_nc(ih,jh,na,ijs) * & + deff_nc(ih,jh,na,ijs) * & alphap(ipol,ik)%nc(jkb,js,ibnd) * uact(mu+ipol) ps2_nc(ikb,is,ibnd,ipol) = ps2_nc(ikb,is,ibnd,ipol) + & deff_nc(ih,jh,na,ijs) * becp1(ik)%nc(jkb,js,ibnd) * & @@ -157,52 +157,52 @@ subroutine dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) deff(ih,jh,na) * becp1(ik)%k(jkb,ibnd) * & (0.d0,-1.d0) * uact(mu+ipol) * tpiba ENDIF -! IF (okvan) THEN -! IF (noncolin) THEN -! ijs = 0 -! DO is = 1, npol -! DO js = 1, npol -! ijs = ijs + 1 -! ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & -! int1_nc(ih,jh,ipol,na,ijs) * & -! becp1(ik)%nc(jkb,js,ibnd) * uact(mu+ipol) -! ENDDO -! ENDDO -! ELSE -! ps1(ikb,ibnd) = ps1(ikb, ibnd) + & -! int1(ih,jh,ipol,na,current_spin) * & -! becp1(ik)%k(jkb,ibnd) * uact(mu+ipol) -! ENDIF -! ENDIF ! okvan + IF (okvan) THEN + IF (noncolin) THEN + ijs = 0 + DO is = 1, npol + DO js = 1, npol + ijs = ijs + 1 + ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & + int1_nc(ih,jh,ipol,na,ijs) * & + becp1(ik)%nc(jkb,js,ibnd) * uact(mu+ipol) + ENDDO + ENDDO + ELSE + ps1(ikb,ibnd) = ps1(ikb, ibnd) + & + int1(ih,jh,ipol,na,current_spin) * & + becp1(ik)%k(jkb,ibnd) * uact(mu+ipol) + ENDIF + ENDIF ! okvan ENDIF ! uact>0 -! IF (okvan) THEN -! DO nb = 1, nat -! nu = 3 * (nb - 1) -! IF (noncolin) THEN -! IF (lspinorb) THEN -! ijs = 0 -! DO is = 1, npol -! DO js = 1, npol -! ijs = ijs + 1 -! ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & -! int2_so(ih,jh,ipol,nb,na,ijs) * & -! becp1(ik)%nc(jkb,js,ibnd) * uact(nu+ipol) -! ENDDO -! ENDDO -! ELSE -! DO is = 1, npol -! ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & -! int2(ih,jh,ipol,nb,na) * & -! becp1(ik)%nc(jkb,is,ibnd) * uact(nu+ipol) -! ENDDO -! ENDIF -! ELSE -! ps1(ikb,ibnd) = ps1(ikb,ibnd) + & -! int2(ih,jh,ipol,nb,na) * & -! becp1(ik)%k(jkb,ibnd) * uact(nu+ipol) -! ENDIF -! ENDDO -! ENDIF ! okvan + IF (okvan) THEN + DO nb = 1, nat + nu = 3 * (nb - 1) + IF (noncolin) THEN + IF (lspinorb) THEN + ijs = 0 + DO is = 1, npol + DO js = 1, npol + ijs = ijs + 1 + ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & + int2_so(ih,jh,ipol,nb,na,ijs) * & + becp1(ik)%nc(jkb,js,ibnd) * uact(nu+ipol) + ENDDO + ENDDO + ELSE + DO is = 1, npol + ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & + int2(ih,jh,ipol,nb,na) * & + becp1(ik)%nc(jkb,is,ibnd) * uact(nu+ipol) + ENDDO + ENDIF + ELSE + ps1(ikb,ibnd) = ps1(ikb,ibnd) + & + int2(ih,jh,ipol,nb,na) * & + becp1(ik)%k(jkb,ibnd) * uact(nu+ipol) + ENDIF + ENDDO + ENDIF ! okvan ENDDO ! ipol ENDDO ! jh ENDDO ! ih @@ -216,27 +216,27 @@ subroutine dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) ! IF (nkb > 0) THEN IF (noncolin) THEN - CALL zgemm('n', 'n', npwq, (upper_band-lower_band+1)*npol, nkb, & - cone, vkb, npwx, ps1_nc, nkb, cone, dvpsi, npwx) + CALL ZGEMM( 'n', 'n', npwq, (upper_band-lower_band+1)*npol, nkb, & + cone, vkb, npwx, ps1_nc, nkb, cone, dvpsi, npwx ) ELSE - CALL zgemm('n', 'n', npwq, (upper_band-lower_band+1), nkb, & - cone, vkb, npwx, ps1, nkb, cone, dvpsi, npwx) + CALL ZGEMM( 'n', 'n', npwq, (upper_band-lower_band+1), nkb, & + cone, vkb, npwx, ps1, nkb, cone, dvpsi, npwx ) ENDIF ENDIF ! ! This term is proportional to (k+q+G)_\alpha*beta(k+q+G) ! - DO ikb=1, nkb - DO ipol=1, 3 - ok = .false. + DO ikb = 1, nkb + DO ipol = 1, 3 + ok = .FALSE. IF (noncolin) THEN DO ibnd = lower_band, upper_band - ok = ok .OR. (ABS(ps2_nc(ikb,1,ibnd,ipol) ) > eps12 ) .OR. & - (ABS(ps2_nc(ikb,2,ibnd,ipol) ) > eps12 ) + ok = ok .OR. ( ABS(ps2_nc(ikb,1,ibnd,ipol) ) > eps12 ) .OR. & + ( ABS(ps2_nc(ikb,2,ibnd,ipol) ) > eps12 ) ENDDO ELSE - DO ibnd=lower_band, upper_band - ok = ok .OR. (ABS(ps2(ikb,ibnd,ipol) ) > eps12) + DO ibnd = lower_band, upper_band + ok = ok .OR. ( ABS(ps2(ikb,ibnd,ipol) ) > eps12) ENDDO ENDIF IF (ok) THEN @@ -247,10 +247,10 @@ subroutine dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) ENDDO DO ibnd = lower_band, upper_band IF (noncolin) THEN - CALL zaxpy( npwq, ps2_nc(ikb,1,ibnd,ipol), aux, 1, dvpsi(1,ibnd), 1 ) - CALL zaxpy( npwq, ps2_nc(ikb,2,ibnd,ipol), aux, 1, dvpsi(1+npwx,ibnd), 1 ) + CALL ZAXPY( npwq, ps2_nc(ikb,1,ibnd,ipol), aux, 1, dvpsi(1,ibnd), 1 ) + CALL ZAXPY( npwq, ps2_nc(ikb,2,ibnd,ipol), aux, 1, dvpsi(1+npwx,ibnd), 1 ) ELSE - CALL zaxpy( npwq, ps2(ikb,ibnd,ipol), aux, 1, dvpsi(1,ibnd), 1 ) + CALL ZAXPY( npwq, ps2(ikb,ibnd,ipol), aux, 1, dvpsi(1,ibnd), 1 ) ENDIF ENDDO ENDIF @@ -259,12 +259,12 @@ subroutine dvqpsi_us_only3 (ik, uact, xxkq, igkq, npwq) ! DEALLOCATE (aux) IF (noncolin) THEN - DEALLOCATE (ps2_nc) DEALLOCATE (ps1_nc) + DEALLOCATE (ps2_nc) DEALLOCATE (deff_nc) ELSE - DEALLOCATE (ps2) DEALLOCATE (ps1) + DEALLOCATE (ps2) DEALLOCATE (deff) ENDIF ! diff --git a/EPW/src/elphon_shuffle_wrap.f90 b/EPW/src/elphon_shuffle_wrap.f90 index 44241e15ed..ae5b9267f4 100644 --- a/EPW/src/elphon_shuffle_wrap.f90 +++ b/EPW/src/elphon_shuffle_wrap.f90 @@ -56,11 +56,12 @@ SUBROUTINE elphon_shuffle_wrap USE constants_epw, ONLY : ryd2ev, zero, czero USE fft_base, ONLY : dfftp USE control_ph, ONLY : u_from_file - USE noncollin_module, ONLY : m_loc, npol + USE noncollin_module, ONLY : m_loc, npol, noncolin USE iotk_module, ONLY : iotk_open_read, iotk_scan_dat, iotk_free_unit, & iotk_close_read USE division, ONLY : fkbounds USE uspp, ONLY : okvan + USE spin_orb, ONLY : lspinorb USE lrus, ONLY : becp1 USE becmod, ONLY : becp, deallocate_bec_type USE phus, ONLY : int1, int1_nc, int2, int2_so, & @@ -85,7 +86,7 @@ SUBROUTINE elphon_shuffle_wrap INTEGER :: maxvalue !! Temporary integer for max value INTEGER :: nqxq_tmp - !! Maximum G+q length ? + !! Maximum G+q length INTEGER :: ibnd !! Band index INTEGER :: ik @@ -230,9 +231,13 @@ SUBROUTINE elphon_shuffle_wrap nqxq_tmp = INT(((SQRT(gcutm) + qnorm_tmp) / dq + 4) * cell_factor) IF (nqxq_tmp > maxvalue) maxvalue = nqxq_tmp ENDDO + ! IF (maxvalue > nqxq) THEN IF (ALLOCATED(qrad)) DEALLOCATE (qrad) ALLOCATE (qrad(maxvalue, nbetam * (nbetam + 1) / 2, lmaxq, nsp)) + qrad(:,:,:,:) = zero + ! RM - need to call init_us_1 to re-calculate qrad + CALL init_us_1 ENDIF ! ! do not perform the check if restart @@ -321,11 +326,11 @@ SUBROUTINE elphon_shuffle_wrap ! dynq(:, :, :) = czero epmatq(:, :, :, :, :) = czero + epsi(:, :) = zero + zstar(:, :, :) = zero bmat(:, :, :, :) = czero cu(:, :, :) = czero cuq(:, :, :) = czero - epsi(:, :) = zero - zstar(:, :, :) = zero ! ! read interatomic force constat matrix from q2r IF (lifc) CALL read_ifc @@ -473,7 +478,7 @@ SUBROUTINE elphon_shuffle_wrap DO iq = 1, nq ! SP: First the vlocq needs to be initialized properly with the first ! q in the star - xq = xq0 + xq = xq0 CALL epw_init(.false.) ! ! retrieve the q in the star @@ -705,18 +710,22 @@ SUBROUTINE elphon_shuffle_wrap DEALLOCATE (int2) DEALLOCATE (int4) DEALLOCATE (int5) - DEALLOCATE (int1_nc) - DEALLOCATE (int4_nc) - DEALLOCATE (int2_so) - DEALLOCATE (int5_so) + IF (noncolin) THEN + DEALLOCATE (int1_nc) + DEALLOCATE (int4_nc) + IF (lspinorb) THEN + DEALLOCATE (int2_so) + DEALLOCATE (int5_so) + ENDIF + ENDIF ENDIF - DO ik=1, nks - DO ipol=1, 3 + DO ik = 1, nks + DO ipol = 1, 3 CALL deallocate_bec_type( alphap(ipol,ik) ) ENDDO ENDDO DEALLOCATE (alphap) - DO ik=1, size(becp1) + DO ik = 1, size(becp1) CALL deallocate_bec_type( becp1(ik) ) ENDDO DEALLOCATE (becp1) diff --git a/EPW/src/ephwann_shuffle.f90 b/EPW/src/ephwann_shuffle.f90 index 1370cc18b6..d11db07fe9 100644 --- a/EPW/src/ephwann_shuffle.f90 +++ b/EPW/src/ephwann_shuffle.f90 @@ -76,7 +76,7 @@ SUBROUTINE ephwann_shuffle (nqc, xqc) USE division, ONLY : fkbounds USE mp, ONLY : mp_barrier, mp_bcast, mp_sum USE io_global, ONLY : ionode_id - USE mp_global, ONLY : inter_pool_comm, intra_pool_comm, root_pool + USE mp_global, ONLY : inter_pool_comm USE mp_world, ONLY : mpime, world_comm #if defined(__MPI) USE parallel_include, ONLY : MPI_MODE_RDONLY, MPI_INFO_NULL, MPI_OFFSET_KIND, & @@ -1885,7 +1885,7 @@ SUBROUTINE epw_read (nrr_k, nrr_q, nrr_g) #endif USE io_global, ONLY : ionode_id USE mp, ONLY : mp_barrier, mp_bcast - USE mp_global, ONLY : intra_pool_comm, inter_pool_comm, root_pool, world_comm + USE mp_global, ONLY : inter_pool_comm, world_comm USE mp_world, ONLY : mpime ! implicit none diff --git a/EPW/src/ephwann_shuffle_mem.f90 b/EPW/src/ephwann_shuffle_mem.f90 index 8825122351..85cf356b54 100644 --- a/EPW/src/ephwann_shuffle_mem.f90 +++ b/EPW/src/ephwann_shuffle_mem.f90 @@ -77,7 +77,7 @@ SUBROUTINE ephwann_shuffle_mem (nqc, xqc) USE division, ONLY : fkbounds USE mp, ONLY : mp_barrier, mp_bcast, mp_sum USE io_global, ONLY : ionode_id - USE mp_global, ONLY : inter_pool_comm, intra_pool_comm, root_pool + USE mp_global, ONLY : inter_pool_comm USE mp_world, ONLY : mpime, world_comm #if defined(__MPI) USE parallel_include, ONLY : MPI_MODE_RDONLY, MPI_INFO_NULL, MPI_OFFSET_KIND, & diff --git a/EPW/src/epw_init.f90 b/EPW/src/epw_init.f90 index 6d88a21528..b7291367b9 100644 --- a/EPW/src/epw_init.f90 +++ b/EPW/src/epw_init.f90 @@ -20,9 +20,9 @@ SUBROUTINE epw_init(first_run) ! USE kinds, ONLY : DP USE ions_base, ONLY : nat, ntyp => nsp, tau - USE becmod, ONLY : calbec + USE becmod, ONLY : calbec, becp, allocate_bec_type USE lrus, ONLY : becp1 - USE uspp, ONLY : vkb + USE uspp, ONLY : vkb, nlcc_any, okvan, nkb USE pwcom, ONLY : npwx, nbnd, nks USE klist_epw, ONLY : xk_loc, isk_loc USE constants, ONLY : tpi @@ -33,21 +33,17 @@ SUBROUTINE epw_init(first_run) USE atom, ONLY : msh, rgrid USE wavefunctions, ONLY : evc USE noncollin_module, ONLY : noncolin, npol, nspin_mag - USE uspp_param, ONLY : upf + USE uspp_param, ONLY : upf, nhm USE m_gth, ONLY : setlocq_gth USE units_lr, ONLY : lrwfc, iuwfc USE phcom, ONLY : vlocq USE qpoint, ONLY : xq, eigqts USE nlcc_ph, ONLY : drc - USE uspp, ONLY : nlcc_any USE elph2, ONLY : igk_k_all, ngk_all USE mp, ONLY : mp_barrier USE mp_global, ONLY : inter_pool_comm, my_pool_id USE spin_orb, ONLY : lspinorb - USE uspp_param, ONLY : nhm - USE uspp, ONLY : okvan, nkb USE lsda_mod, ONLY : nspin, lsda, current_spin - USE becmod, ONLY : becp, allocate_bec_type USE phus, ONLY : int1, int1_nc, int2, int2_so, & int4, int4_nc, int5, int5_so, & alphap @@ -110,7 +106,7 @@ SUBROUTINE epw_init(first_run) CALL allocate_bec_type(nkb, nbnd, becp) ENDIF ! - DO na=1, nat + DO na = 1, nat ! ! xq here is the first q of the star arg = (xq(1) * tau(1, na) + & @@ -144,7 +140,7 @@ SUBROUTINE epw_init(first_run) ALLOCATE (aux1(npwx*npol, nbnd)) !ALLOCATE (evc(npwx*npol, nbnd)) ! - DO ik=1, nks + DO ik = 1, nks ! ! IF (lsda) current_spin = isk_loc(ik) @@ -180,16 +176,15 @@ SUBROUTINE epw_init(first_run) ENDDO ENDIF ENDDO - CALL calbec( ngk(ik), vkb, aux1, alphap(ipol,ik) ) + CALL calbec( ngk(ik), vkb, aux1, alphap(ipol,ik) ) ENDDO ! - ! ENDDO ! DEALLOCATE (aux1) ! - IF( .NOT. ALLOCATED(igk_k_all)) ALLOCATE (igk_k_all(npwx,nkstot)) - IF( .NOT. ALLOCATED(ngk_all)) ALLOCATE (ngk_all(nkstot)) + IF( .NOT. ALLOCATED(igk_k_all) ) ALLOCATE (igk_k_all(npwx,nkstot)) + IF( .NOT. ALLOCATED(ngk_all) ) ALLOCATE (ngk_all(nkstot)) ! #if defined(__MPI) ! @@ -204,7 +199,7 @@ SUBROUTINE epw_init(first_run) ! #endif ! - IF ( .NOT. first_run) CALL dvanqq2() + IF ( .NOT. first_run ) CALL dvanqq2() ! CALL stop_clock( 'epw_init' ) ! diff --git a/EPW/src/epw_readin.f90 b/EPW/src/epw_readin.f90 index f2bc2309c0..40c360c712 100644 --- a/EPW/src/epw_readin.f90 +++ b/EPW/src/epw_readin.f90 @@ -73,7 +73,6 @@ SUBROUTINE epw_readin USE io_global, ONLY : meta_ionode, meta_ionode_id, ionode_id USE io_epw, ONLY : iunkf, iunqf USE noncollin_module, ONLY : npol - USE wavefunctions, ONLY : evc USE wvfct, ONLY : npwx #if defined(__NAG) USE F90_UNIX_ENV, ONLY : iargc, getarg diff --git a/EPW/src/newdq2.f90 b/EPW/src/newdq2.f90 index 4622dec457..9627dc169d 100644 --- a/EPW/src/newdq2.f90 +++ b/EPW/src/newdq2.f90 @@ -33,7 +33,7 @@ SUBROUTINE newdq2( dvscf, npe, xq0, timerev ) USE mp, ONLY : mp_sum USE lrus, ONLY : int3 USE qpoint, ONLY : eigqts - USE constants_epw, ONLY : czero + USE constants_epw, ONLY : czero, zero ! IMPLICIT NONE ! @@ -72,15 +72,15 @@ SUBROUTINE newdq2( dvscf, npe, xq0, timerev ) REAL(kind=DP), ALLOCATABLE :: ylmk0(:,:) !! the spherical harmonics at q+G ! - COMPLEX(kind=DP), EXTERNAL :: zdotc + COMPLEX(kind=DP), EXTERNAL :: ZDOTC !! the scalar product function COMPLEX(kind=DP), ALLOCATABLE :: aux1(:), aux2(:,:) COMPLEX(kind=DP), ALLOCATABLE :: qgm(:) - !! the augmentation function at G + !! the augmentation function at q+G COMPLEX(kind=DP), ALLOCATABLE :: veff(:) !! effective potential ! - IF ( .NOT. okvan) RETURN + IF (.NOT. okvan) RETURN ! CALL start_clock('newdq2') ! @@ -93,11 +93,19 @@ SUBROUTINE newdq2( dvscf, npe, xq0, timerev ) ALLOCATE ( qgm(ngm) ) ALLOCATE ( qmod(ngm) ) ALLOCATE ( qg(3,ngm) ) + aux1(:) = czero + aux2(:,:) = czero + veff(:) = czero + ylmk0(:,:) = zero + qgm(:) = czero + qmod(:) = zero + qg(:,:) = zero ! ! first compute the spherical harmonics ! CALL setqmod( ngm, xq0, g, qmod, qg ) CALL ylmr2( lmaxq * lmaxq, ngm, qg, qmod, ylmk0 ) + ! DO ig = 1, ngm qmod(ig) = sqrt( qmod(ig) ) ENDDO @@ -127,6 +135,7 @@ SUBROUTINE newdq2( dvscf, npe, xq0, timerev ) ! DO ih = 1, nh(nt) DO jh = ih, nh(nt) + ! CALL qvan2( ngm, ih, jh, nt, qmod, qgm, ylmk0 ) ! DO na = 1, nat @@ -139,7 +148,7 @@ SUBROUTINE newdq2( dvscf, npe, xq0, timerev ) ENDDO DO is = 1, nspin_mag int3(ih,jh,na,is,ipert) = omega * & - zdotc(ngm,aux1,1,aux2(1,is),1) + ZDOTC(ngm,aux1,1,aux2(1,is),1) ENDDO ENDIF ENDDO diff --git a/EPW/src/pw2wan90epw.f90 b/EPW/src/pw2wan90epw.f90 index 771f83ec33..532544e94d 100644 --- a/EPW/src/pw2wan90epw.f90 +++ b/EPW/src/pw2wan90epw.f90 @@ -1567,8 +1567,8 @@ SUBROUTINE compute_pmn_para ! any_uspp = ANY( upf(:)%tvanp ) ! - IF (any_uspp .and. noncolin) CALL errore('pw2wan90epw',& - 'noncolin calculation not implimented with USP',1) + IF ( any_uspp ) CALL errore('pw2wan90epw',& + 'dipole matrix calculation not implimented with USP - set vme=.true.',1) ! ALLOCATE (dmec(3, nbnd, nbnd, nks)) ! From 8b3b1b713c1b78764ee1741b07ac18a52d3590ac Mon Sep 17 00:00:00 2001 From: Samuel Ponce Date: Wed, 17 Jul 2019 12:16:25 +0100 Subject: [PATCH 76/95] Update the uspp test since USPP only works with vme == .true. now. --- .../benchmark.out.git.inp=epw1.in.args=3 | 482 +++++++++--------- test-suite/epw_trev_uspp/epw1.in | 21 +- 2 files changed, 258 insertions(+), 245 deletions(-) diff --git a/test-suite/epw_trev_uspp/benchmark.out.git.inp=epw1.in.args=3 b/test-suite/epw_trev_uspp/benchmark.out.git.inp=epw1.in.args=3 index f8c29a0889..f491f7b589 100644 --- a/test-suite/epw_trev_uspp/benchmark.out.git.inp=epw1.in.args=3 +++ b/test-suite/epw_trev_uspp/benchmark.out.git.inp=epw1.in.args=3 @@ -27,7 +27,7 @@ Comput. Phys. Commun. 209, 116 (2016) - Program EPW v.5.0.0 starts on 18Jan2019 at 19: 6:16 + Program EPW v.5.1.0 starts on 17Jul2019 at 12:13:57 This program is part of the open-source Quantum ESPRESSO suite for quantum simulation of materials; please cite @@ -45,7 +45,8 @@ ./sic.save/ IMPORTANT: XC functional enforced from input : - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) Any further DFT definition will be discarded Please, verify this is what you really want @@ -66,7 +67,8 @@ number of atomic types = 2 kinetic-energy cut-off = 30.0000 Ry charge density cut-off = 120.0000 Ry - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.23700 celldm(2)= 0.00000 celldm(3)= 0.00000 @@ -147,9 +149,9 @@ l(4) = 1 Q(r) pseudized with 0 coefficients - EPW : 0.26s CPU 0.26s WALL + EPW : 0.27s CPU 0.28s WALL - EPW : 0.31s CPU 0.32s WALL + EPW : 0.32s CPU 0.33s WALL No wavefunction gauge setting applied ------------------------------------------------------------------- @@ -251,16 +253,13 @@ ( -0.16235 -0.16235 0.16235) : 0.87049 ------------------------------------------------------------------- - WANNIER : 2.04s CPU 2.05s WALL ( 1 calls) + WANNIER : 1.99s CPU 1.99s WALL ( 1 calls) ------------------------------------------------------------------- - Dipole matrix elements calculated - - Calculating kgmap Progress kgmap: ######################################## - kmaps : 0.22s CPU 0.22s WALL ( 1 calls) + kmaps : 0.20s CPU 0.21s WALL ( 1 calls) Symmetries of Bravais lattice: 48 Symmetries of crystal: 24 @@ -372,23 +371,23 @@ The .epb files have been correctly written + + Computes the analytic long-range interaction for polar materials [lpolar] + Construct the Wigner-Seitz cell using Wannier centers and atomic positions Number of WS vectors for electrons 79 Number of WS vectors for phonons 63 Number of WS vectors for electron-phonon 53 Maximum number of cores for efficient parallelization 106 - Writing Hamiltonian, Dynamical matrix and EP vertex in Wann rep to file - - - Reading Hamiltonian, Dynamical matrix and EP vertex in Wann rep from file - + Velocity matrix elements calculated + - Finished reading Wann rep data from file + Writing Hamiltonian, Dynamical matrix and EP vertex in Wann rep to file =================================================================== - Memory usage: VmHWM = 31Mb - VmPeak = 301Mb + Memory usage: VmHWM = 30Mb + VmPeak = 302Mb =================================================================== Using q-mesh file: pathq.dat @@ -419,60 +418,60 @@ ik = 1 coord.: 0.0000000 0.0000000 0.0000000 ibnd jbnd imode enk[eV] enk+q[eV] omega(q)[meV] |g|[meV] ------------------------------------------------------------------------------ - 2 2 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 2 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 2 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 2 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 2 2 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 2 2 6 9.5362 9.5362 96.9696 0.1152036546E+03 - 2 3 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 3 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 3 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 3 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 2 3 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 2 3 6 9.5362 9.5362 96.9696 0.1152036546E+03 - 2 4 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 4 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 4 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 2 4 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 2 4 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 2 4 6 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 2 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 2 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 2 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 2 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 2 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 2 6 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 3 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 3 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 3 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 3 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 3 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 3 6 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 4 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 4 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 4 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 3 4 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 4 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 3 4 6 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 2 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 2 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 2 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 2 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 2 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 2 6 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 3 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 3 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 3 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 3 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 3 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 3 6 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 4 1 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 4 2 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 4 3 9.5362 9.5362 0.0000 0.3356727864E+02 - 4 4 4 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 4 5 9.5362 9.5362 96.9696 0.1152036546E+03 - 4 4 6 9.5362 9.5362 96.9696 0.1152036546E+03 + 2 2 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 2 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 2 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 2 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 2 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 2 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 3 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 3 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 3 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 3 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 3 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 3 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 4 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 4 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 4 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 2 4 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 4 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 4 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 2 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 2 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 2 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 2 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 2 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 2 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 3 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 3 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 3 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 3 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 3 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 3 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 4 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 4 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 4 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 3 4 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 4 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 3 4 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 2 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 2 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 2 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 2 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 2 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 2 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 3 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 3 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 3 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 3 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 3 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 3 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 4 1 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 4 2 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 4 3 9.5362 9.5362 0.0000 0.3519101343E+02 + 4 4 4 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 4 5 9.5362 9.5362 96.9696 0.1152035784E+03 + 4 4 6 9.5362 9.5362 96.9696 0.1152035784E+03 ------------------------------------------------------------------------------ Electron-phonon vertex |g| (meV) @@ -481,60 +480,60 @@ ik = 1 coord.: 0.0000000 0.0000000 0.0000000 ibnd jbnd imode enk[eV] enk+q[eV] omega(q)[meV] |g|[meV] ------------------------------------------------------------------------------ - 2 2 1 9.5362 3.3767 29.0464 0.3098790956E+02 - 2 2 2 9.5362 3.3767 29.0464 0.3098790956E+02 - 2 2 3 9.5362 3.3767 62.4896 0.9280967135E+02 - 2 2 4 9.5362 3.3767 94.2352 0.7542390365E+02 - 2 2 5 9.5362 3.3767 94.2352 0.7542390365E+02 - 2 2 6 9.5362 3.3767 109.2915 0.1251759224E+03 - 2 3 1 9.5362 8.6927 29.0464 0.2601275765E+02 - 2 3 2 9.5362 8.6927 29.0464 0.2601275765E+02 - 2 3 3 9.5362 8.6927 62.4896 0.1258616594E+03 - 2 3 4 9.5362 8.6927 94.2352 0.1244187173E+03 - 2 3 5 9.5362 8.6927 94.2352 0.1244187173E+03 - 2 3 6 9.5362 8.6927 109.2915 0.1464359089E+03 - 2 4 1 9.5362 8.6927 29.0464 0.2601275765E+02 - 2 4 2 9.5362 8.6927 29.0464 0.2601275765E+02 - 2 4 3 9.5362 8.6927 62.4896 0.1258616594E+03 - 2 4 4 9.5362 8.6927 94.2352 0.1244187173E+03 - 2 4 5 9.5362 8.6927 94.2352 0.1244187173E+03 - 2 4 6 9.5362 8.6927 109.2915 0.1464359089E+03 - 3 2 1 9.5362 3.3767 29.0464 0.3098790956E+02 - 3 2 2 9.5362 3.3767 29.0464 0.3098790956E+02 - 3 2 3 9.5362 3.3767 62.4896 0.9280967135E+02 - 3 2 4 9.5362 3.3767 94.2352 0.7542390365E+02 - 3 2 5 9.5362 3.3767 94.2352 0.7542390365E+02 - 3 2 6 9.5362 3.3767 109.2915 0.1251759224E+03 - 3 3 1 9.5362 8.6927 29.0464 0.2601275765E+02 - 3 3 2 9.5362 8.6927 29.0464 0.2601275765E+02 - 3 3 3 9.5362 8.6927 62.4896 0.1258616594E+03 - 3 3 4 9.5362 8.6927 94.2352 0.1244187173E+03 - 3 3 5 9.5362 8.6927 94.2352 0.1244187173E+03 - 3 3 6 9.5362 8.6927 109.2915 0.1464359089E+03 - 3 4 1 9.5362 8.6927 29.0464 0.2601275765E+02 - 3 4 2 9.5362 8.6927 29.0464 0.2601275765E+02 - 3 4 3 9.5362 8.6927 62.4896 0.1258616594E+03 - 3 4 4 9.5362 8.6927 94.2352 0.1244187173E+03 - 3 4 5 9.5362 8.6927 94.2352 0.1244187173E+03 - 3 4 6 9.5362 8.6927 109.2915 0.1464359089E+03 - 4 2 1 9.5362 3.3767 29.0464 0.3098790956E+02 - 4 2 2 9.5362 3.3767 29.0464 0.3098790956E+02 - 4 2 3 9.5362 3.3767 62.4896 0.9280967135E+02 - 4 2 4 9.5362 3.3767 94.2352 0.7542390365E+02 - 4 2 5 9.5362 3.3767 94.2352 0.7542390365E+02 - 4 2 6 9.5362 3.3767 109.2915 0.1251759224E+03 - 4 3 1 9.5362 8.6927 29.0464 0.2601275765E+02 - 4 3 2 9.5362 8.6927 29.0464 0.2601275765E+02 - 4 3 3 9.5362 8.6927 62.4896 0.1258616594E+03 - 4 3 4 9.5362 8.6927 94.2352 0.1244187173E+03 - 4 3 5 9.5362 8.6927 94.2352 0.1244187173E+03 - 4 3 6 9.5362 8.6927 109.2915 0.1464359089E+03 - 4 4 1 9.5362 8.6927 29.0464 0.2601275765E+02 - 4 4 2 9.5362 8.6927 29.0464 0.2601275765E+02 - 4 4 3 9.5362 8.6927 62.4896 0.1258616594E+03 - 4 4 4 9.5362 8.6927 94.2352 0.1244187173E+03 - 4 4 5 9.5362 8.6927 94.2352 0.1244187173E+03 - 4 4 6 9.5362 8.6927 109.2915 0.1464359089E+03 + 2 2 1 9.5362 3.3767 29.0461 0.2853406535E+02 + 2 2 2 9.5362 3.3767 29.0461 0.2853406535E+02 + 2 2 3 9.5362 3.3767 62.4893 0.1121901696E+03 + 2 2 4 9.5362 3.3767 94.2351 0.1032444000E+03 + 2 2 5 9.5362 3.3767 94.2351 0.1032444000E+03 + 2 2 6 9.5362 3.3767 109.2914 0.1372711279E+03 + 2 3 1 9.5362 8.6927 29.0461 0.2853406535E+02 + 2 3 2 9.5362 8.6927 29.0461 0.2853406535E+02 + 2 3 3 9.5362 8.6927 62.4893 0.1121901696E+03 + 2 3 4 9.5362 8.6927 94.2351 0.1032444000E+03 + 2 3 5 9.5362 8.6927 94.2351 0.1032444000E+03 + 2 3 6 9.5362 8.6927 109.2914 0.1372711279E+03 + 2 4 1 9.5362 8.6927 29.0461 0.2853406535E+02 + 2 4 2 9.5362 8.6927 29.0461 0.2853406535E+02 + 2 4 3 9.5362 8.6927 62.4893 0.1121901696E+03 + 2 4 4 9.5362 8.6927 94.2351 0.1032444000E+03 + 2 4 5 9.5362 8.6927 94.2351 0.1032444000E+03 + 2 4 6 9.5362 8.6927 109.2914 0.1372711279E+03 + 3 2 1 9.5362 3.3767 29.0461 0.2738064309E+02 + 3 2 2 9.5362 3.3767 29.0461 0.2738064309E+02 + 3 2 3 9.5362 3.3767 62.4893 0.1177059697E+03 + 3 2 4 9.5362 3.3767 94.2351 0.1139944117E+03 + 3 2 5 9.5362 3.3767 94.2351 0.1139944117E+03 + 3 2 6 9.5362 3.3767 109.2914 0.1409130214E+03 + 3 3 1 9.5362 8.6927 29.0461 0.2738064309E+02 + 3 3 2 9.5362 8.6927 29.0461 0.2738064309E+02 + 3 3 3 9.5362 8.6927 62.4893 0.1177059697E+03 + 3 3 4 9.5362 8.6927 94.2351 0.1139944117E+03 + 3 3 5 9.5362 8.6927 94.2351 0.1139944117E+03 + 3 3 6 9.5362 8.6927 109.2914 0.1409130214E+03 + 3 4 1 9.5362 8.6927 29.0461 0.2738064309E+02 + 3 4 2 9.5362 8.6927 29.0461 0.2738064309E+02 + 3 4 3 9.5362 8.6927 62.4893 0.1177059697E+03 + 3 4 4 9.5362 8.6927 94.2351 0.1139944117E+03 + 3 4 5 9.5362 8.6927 94.2351 0.1139944117E+03 + 3 4 6 9.5362 8.6927 109.2914 0.1409130214E+03 + 4 2 1 9.5362 3.3767 29.0461 0.2738064309E+02 + 4 2 2 9.5362 3.3767 29.0461 0.2738064309E+02 + 4 2 3 9.5362 3.3767 62.4893 0.1177059697E+03 + 4 2 4 9.5362 3.3767 94.2351 0.1139944117E+03 + 4 2 5 9.5362 3.3767 94.2351 0.1139944117E+03 + 4 2 6 9.5362 3.3767 109.2914 0.1409130214E+03 + 4 3 1 9.5362 8.6927 29.0461 0.2738064309E+02 + 4 3 2 9.5362 8.6927 29.0461 0.2738064309E+02 + 4 3 3 9.5362 8.6927 62.4893 0.1177059697E+03 + 4 3 4 9.5362 8.6927 94.2351 0.1139944117E+03 + 4 3 5 9.5362 8.6927 94.2351 0.1139944117E+03 + 4 3 6 9.5362 8.6927 109.2914 0.1409130214E+03 + 4 4 1 9.5362 8.6927 29.0461 0.2738064309E+02 + 4 4 2 9.5362 8.6927 29.0461 0.2738064309E+02 + 4 4 3 9.5362 8.6927 62.4893 0.1177059697E+03 + 4 4 4 9.5362 8.6927 94.2351 0.1139944117E+03 + 4 4 5 9.5362 8.6927 94.2351 0.1139944117E+03 + 4 4 6 9.5362 8.6927 109.2914 0.1409130214E+03 ------------------------------------------------------------------------------ Electron-phonon vertex |g| (meV) @@ -543,60 +542,60 @@ ik = 1 coord.: 0.0000000 0.0000000 0.0000000 ibnd jbnd imode enk[eV] enk+q[eV] omega(q)[meV] |g|[meV] ------------------------------------------------------------------------------ - 2 2 1 9.5362 4.5130 40.9084 0.4194847423E+02 - 2 2 2 9.5362 4.5130 40.9084 0.4194847423E+02 - 2 2 3 9.5362 4.5130 62.8687 0.3170165291E+02 - 2 2 4 9.5362 4.5130 93.7701 0.1197897914E+03 - 2 2 5 9.5362 4.5130 93.7701 0.1197897914E+03 - 2 2 6 9.5362 4.5130 109.2933 0.5188756740E+02 - 2 3 1 9.5362 6.9263 40.9084 0.1141115167E+02 - 2 3 2 9.5362 6.9263 40.9084 0.1141115167E+02 - 2 3 3 9.5362 6.9263 62.8687 0.1314917363E+03 - 2 3 4 9.5362 6.9263 93.7701 0.7353510442E+02 - 2 3 5 9.5362 6.9263 93.7701 0.7353510442E+02 - 2 3 6 9.5362 6.9263 109.2933 0.1643855028E+03 - 2 4 1 9.5362 6.9263 40.9084 0.1141115167E+02 - 2 4 2 9.5362 6.9263 40.9084 0.1141115167E+02 - 2 4 3 9.5362 6.9263 62.8687 0.1314917363E+03 - 2 4 4 9.5362 6.9263 93.7701 0.7353510442E+02 - 2 4 5 9.5362 6.9263 93.7701 0.7353510442E+02 - 2 4 6 9.5362 6.9263 109.2933 0.1643855028E+03 - 3 2 1 9.5362 4.5130 40.9084 0.4194847423E+02 - 3 2 2 9.5362 4.5130 40.9084 0.4194847423E+02 - 3 2 3 9.5362 4.5130 62.8687 0.3170165291E+02 - 3 2 4 9.5362 4.5130 93.7701 0.1197897914E+03 - 3 2 5 9.5362 4.5130 93.7701 0.1197897914E+03 - 3 2 6 9.5362 4.5130 109.2933 0.5188756740E+02 - 3 3 1 9.5362 6.9263 40.9084 0.1141115167E+02 - 3 3 2 9.5362 6.9263 40.9084 0.1141115167E+02 - 3 3 3 9.5362 6.9263 62.8687 0.1314917363E+03 - 3 3 4 9.5362 6.9263 93.7701 0.7353510442E+02 - 3 3 5 9.5362 6.9263 93.7701 0.7353510442E+02 - 3 3 6 9.5362 6.9263 109.2933 0.1643855028E+03 - 3 4 1 9.5362 6.9263 40.9084 0.1141115167E+02 - 3 4 2 9.5362 6.9263 40.9084 0.1141115167E+02 - 3 4 3 9.5362 6.9263 62.8687 0.1314917363E+03 - 3 4 4 9.5362 6.9263 93.7701 0.7353510442E+02 - 3 4 5 9.5362 6.9263 93.7701 0.7353510442E+02 - 3 4 6 9.5362 6.9263 109.2933 0.1643855028E+03 - 4 2 1 9.5362 4.5130 40.9084 0.4194847423E+02 - 4 2 2 9.5362 4.5130 40.9084 0.4194847423E+02 - 4 2 3 9.5362 4.5130 62.8687 0.3170165291E+02 - 4 2 4 9.5362 4.5130 93.7701 0.1197897914E+03 - 4 2 5 9.5362 4.5130 93.7701 0.1197897914E+03 - 4 2 6 9.5362 4.5130 109.2933 0.5188756740E+02 - 4 3 1 9.5362 6.9263 40.9084 0.1141115167E+02 - 4 3 2 9.5362 6.9263 40.9084 0.1141115167E+02 - 4 3 3 9.5362 6.9263 62.8687 0.1314917363E+03 - 4 3 4 9.5362 6.9263 93.7701 0.7353510442E+02 - 4 3 5 9.5362 6.9263 93.7701 0.7353510442E+02 - 4 3 6 9.5362 6.9263 109.2933 0.1643855028E+03 - 4 4 1 9.5362 6.9263 40.9084 0.1141115167E+02 - 4 4 2 9.5362 6.9263 40.9084 0.1141115167E+02 - 4 4 3 9.5362 6.9263 62.8687 0.1314917363E+03 - 4 4 4 9.5362 6.9263 93.7701 0.7353510442E+02 - 4 4 5 9.5362 6.9263 93.7701 0.7353510442E+02 - 4 4 6 9.5362 6.9263 109.2933 0.1643855028E+03 + 2 2 1 9.5362 4.5130 40.9082 0.2477307077E+02 + 2 2 2 9.5362 4.5130 40.9082 0.2477307077E+02 + 2 2 3 9.5362 4.5130 62.8657 0.1014416910E+03 + 2 2 4 9.5362 4.5130 93.7699 0.9348130446E+02 + 2 2 5 9.5362 4.5130 93.7699 0.9348130446E+02 + 2 2 6 9.5362 4.5130 109.2888 0.1287308185E+03 + 2 3 1 9.5362 6.9263 40.9082 0.2477307077E+02 + 2 3 2 9.5362 6.9263 40.9082 0.2477307077E+02 + 2 3 3 9.5362 6.9263 62.8657 0.1014416910E+03 + 2 3 4 9.5362 6.9263 93.7699 0.9348130446E+02 + 2 3 5 9.5362 6.9263 93.7699 0.9348130446E+02 + 2 3 6 9.5362 6.9263 109.2888 0.1287308185E+03 + 2 4 1 9.5362 6.9263 40.9082 0.2477307077E+02 + 2 4 2 9.5362 6.9263 40.9082 0.2477307077E+02 + 2 4 3 9.5362 6.9263 62.8657 0.1014416910E+03 + 2 4 4 9.5362 6.9263 93.7699 0.9348130446E+02 + 2 4 5 9.5362 6.9263 93.7699 0.9348130446E+02 + 2 4 6 9.5362 6.9263 109.2888 0.1287308185E+03 + 3 2 1 9.5362 4.5130 40.9082 0.2651779195E+02 + 3 2 2 9.5362 4.5130 40.9082 0.2651779195E+02 + 3 2 3 9.5362 4.5130 62.8657 0.1124393853E+03 + 3 2 4 9.5362 4.5130 93.7699 0.9062483731E+02 + 3 2 5 9.5362 4.5130 93.7699 0.9062483731E+02 + 3 2 6 9.5362 4.5130 109.2888 0.1417295666E+03 + 3 3 1 9.5362 6.9263 40.9082 0.2651779195E+02 + 3 3 2 9.5362 6.9263 40.9082 0.2651779195E+02 + 3 3 3 9.5362 6.9263 62.8657 0.1124393853E+03 + 3 3 4 9.5362 6.9263 93.7699 0.9062483731E+02 + 3 3 5 9.5362 6.9263 93.7699 0.9062483731E+02 + 3 3 6 9.5362 6.9263 109.2888 0.1417295666E+03 + 3 4 1 9.5362 6.9263 40.9082 0.2651779195E+02 + 3 4 2 9.5362 6.9263 40.9082 0.2651779195E+02 + 3 4 3 9.5362 6.9263 62.8657 0.1124393853E+03 + 3 4 4 9.5362 6.9263 93.7699 0.9062483731E+02 + 3 4 5 9.5362 6.9263 93.7699 0.9062483731E+02 + 3 4 6 9.5362 6.9263 109.2888 0.1417295666E+03 + 4 2 1 9.5362 4.5130 40.9082 0.2651779195E+02 + 4 2 2 9.5362 4.5130 40.9082 0.2651779195E+02 + 4 2 3 9.5362 4.5130 62.8657 0.1124393853E+03 + 4 2 4 9.5362 4.5130 93.7699 0.9062483731E+02 + 4 2 5 9.5362 4.5130 93.7699 0.9062483731E+02 + 4 2 6 9.5362 4.5130 109.2888 0.1417295666E+03 + 4 3 1 9.5362 6.9263 40.9082 0.2651779195E+02 + 4 3 2 9.5362 6.9263 40.9082 0.2651779195E+02 + 4 3 3 9.5362 6.9263 62.8657 0.1124393853E+03 + 4 3 4 9.5362 6.9263 93.7699 0.9062483731E+02 + 4 3 5 9.5362 6.9263 93.7699 0.9062483731E+02 + 4 3 6 9.5362 6.9263 109.2888 0.1417295666E+03 + 4 4 1 9.5362 6.9263 40.9082 0.2651779195E+02 + 4 4 2 9.5362 6.9263 40.9082 0.2651779195E+02 + 4 4 3 9.5362 6.9263 62.8657 0.1124393853E+03 + 4 4 4 9.5362 6.9263 93.7699 0.9062483731E+02 + 4 4 5 9.5362 6.9263 93.7699 0.9062483731E+02 + 4 4 6 9.5362 6.9263 109.2888 0.1417295666E+03 ------------------------------------------------------------------------------ Electron-phonon vertex |g| (meV) @@ -605,85 +604,86 @@ ik = 1 coord.: 0.0000000 0.0000000 0.0000000 ibnd jbnd imode enk[eV] enk+q[eV] omega(q)[meV] |g|[meV] ------------------------------------------------------------------------------ - 2 2 1 9.5362 2.5291 42.3398 0.5933004589E+02 - 2 2 2 9.5362 2.5291 58.0658 0.5280358644E+02 - 2 2 3 9.5362 2.5291 65.8200 0.1093263246E+03 - 2 2 4 9.5362 2.5291 92.0117 0.6149939971E+01 - 2 2 5 9.5362 2.5291 92.2193 0.4953068343E+02 - 2 2 6 9.5362 2.5291 105.8096 0.1336299247E+03 - 2 3 1 9.5362 3.9023 42.3398 0.2307923449E+02 - 2 3 2 9.5362 3.9023 58.0658 0.4875566957E+02 - 2 3 3 9.5362 3.9023 65.8200 0.1115183127E+03 - 2 3 4 9.5362 3.9023 92.0117 0.9111482842E+02 - 2 3 5 9.5362 3.9023 92.2193 0.5178673920E+02 - 2 3 6 9.5362 3.9023 105.8096 0.3556518912E+02 - 2 4 1 9.5362 7.3625 42.3398 0.5010294468E+02 - 2 4 2 9.5362 7.3625 58.0658 0.2949120021E+02 - 2 4 3 9.5362 7.3625 65.8200 0.1480592816E+03 - 2 4 4 9.5362 7.3625 92.0117 0.1078754791E+03 - 2 4 5 9.5362 7.3625 92.2193 0.1869269993E+02 - 2 4 6 9.5362 7.3625 105.8096 0.1278261567E+03 - 3 2 1 9.5362 2.5291 42.3398 0.5933004589E+02 - 3 2 2 9.5362 2.5291 58.0658 0.5280358644E+02 - 3 2 3 9.5362 2.5291 65.8200 0.1093263246E+03 - 3 2 4 9.5362 2.5291 92.0117 0.6149939971E+01 - 3 2 5 9.5362 2.5291 92.2193 0.4953068343E+02 - 3 2 6 9.5362 2.5291 105.8096 0.1336299247E+03 - 3 3 1 9.5362 3.9023 42.3398 0.2307923449E+02 - 3 3 2 9.5362 3.9023 58.0658 0.4875566957E+02 - 3 3 3 9.5362 3.9023 65.8200 0.1115183127E+03 - 3 3 4 9.5362 3.9023 92.0117 0.9111482842E+02 - 3 3 5 9.5362 3.9023 92.2193 0.5178673920E+02 - 3 3 6 9.5362 3.9023 105.8096 0.3556518912E+02 - 3 4 1 9.5362 7.3625 42.3398 0.5010294468E+02 - 3 4 2 9.5362 7.3625 58.0658 0.2949120021E+02 - 3 4 3 9.5362 7.3625 65.8200 0.1480592816E+03 - 3 4 4 9.5362 7.3625 92.0117 0.1078754791E+03 - 3 4 5 9.5362 7.3625 92.2193 0.1869269993E+02 - 3 4 6 9.5362 7.3625 105.8096 0.1278261567E+03 - 4 2 1 9.5362 2.5291 42.3398 0.5933004589E+02 - 4 2 2 9.5362 2.5291 58.0658 0.5280358644E+02 - 4 2 3 9.5362 2.5291 65.8200 0.1093263246E+03 - 4 2 4 9.5362 2.5291 92.0117 0.6149939971E+01 - 4 2 5 9.5362 2.5291 92.2193 0.4953068343E+02 - 4 2 6 9.5362 2.5291 105.8096 0.1336299247E+03 - 4 3 1 9.5362 3.9023 42.3398 0.2307923449E+02 - 4 3 2 9.5362 3.9023 58.0658 0.4875566957E+02 - 4 3 3 9.5362 3.9023 65.8200 0.1115183127E+03 - 4 3 4 9.5362 3.9023 92.0117 0.9111482842E+02 - 4 3 5 9.5362 3.9023 92.2193 0.5178673920E+02 - 4 3 6 9.5362 3.9023 105.8096 0.3556518912E+02 - 4 4 1 9.5362 7.3625 42.3398 0.5010294468E+02 - 4 4 2 9.5362 7.3625 58.0658 0.2949120021E+02 - 4 4 3 9.5362 7.3625 65.8200 0.1480592816E+03 - 4 4 4 9.5362 7.3625 92.0117 0.1078754791E+03 - 4 4 5 9.5362 7.3625 92.2193 0.1869269993E+02 - 4 4 6 9.5362 7.3625 105.8096 0.1278261567E+03 + 2 2 1 9.5362 2.5291 42.3397 0.4664118925E+02 + 2 2 2 9.5362 2.5291 58.0655 0.4993970589E+02 + 2 2 3 9.5362 2.5291 65.8200 0.1206035829E+03 + 2 2 4 9.5362 2.5291 92.0116 0.9092749278E+02 + 2 2 5 9.5362 2.5291 92.2178 0.4644773796E+02 + 2 2 6 9.5362 2.5291 105.8068 0.1046925861E+03 + 2 3 1 9.5362 3.9023 42.3397 0.4664118925E+02 + 2 3 2 9.5362 3.9023 58.0655 0.4993970589E+02 + 2 3 3 9.5362 3.9023 65.8200 0.1206035829E+03 + 2 3 4 9.5362 3.9023 92.0116 0.9092749278E+02 + 2 3 5 9.5362 3.9023 92.2178 0.4644773796E+02 + 2 3 6 9.5362 3.9023 105.8068 0.1046925861E+03 + 2 4 1 9.5362 7.3625 42.3397 0.4664118925E+02 + 2 4 2 9.5362 7.3625 58.0655 0.4993970589E+02 + 2 4 3 9.5362 7.3625 65.8200 0.1206035829E+03 + 2 4 4 9.5362 7.3625 92.0116 0.9092749278E+02 + 2 4 5 9.5362 7.3625 92.2178 0.4644773796E+02 + 2 4 6 9.5362 7.3625 105.8068 0.1046925861E+03 + 3 2 1 9.5362 2.5291 42.3397 0.4180598853E+02 + 3 2 2 9.5362 2.5291 58.0655 0.5300248882E+02 + 3 2 3 9.5362 2.5291 65.8200 0.1115028654E+03 + 3 2 4 9.5362 2.5291 92.0116 0.8015134537E+02 + 3 2 5 9.5362 2.5291 92.2178 0.4693935033E+02 + 3 2 6 9.5362 2.5291 105.8068 0.9008050165E+02 + 3 3 1 9.5362 3.9023 42.3397 0.4180598853E+02 + 3 3 2 9.5362 3.9023 58.0655 0.5300248882E+02 + 3 3 3 9.5362 3.9023 65.8200 0.1115028654E+03 + 3 3 4 9.5362 3.9023 92.0116 0.8015134537E+02 + 3 3 5 9.5362 3.9023 92.2178 0.4693935033E+02 + 3 3 6 9.5362 3.9023 105.8068 0.9008050165E+02 + 3 4 1 9.5362 7.3625 42.3397 0.4180598853E+02 + 3 4 2 9.5362 7.3625 58.0655 0.5300248882E+02 + 3 4 3 9.5362 7.3625 65.8200 0.1115028654E+03 + 3 4 4 9.5362 7.3625 92.0116 0.8015134537E+02 + 3 4 5 9.5362 7.3625 92.2178 0.4693935033E+02 + 3 4 6 9.5362 7.3625 105.8068 0.9008050165E+02 + 4 2 1 9.5362 2.5291 42.3397 0.5137983042E+02 + 4 2 2 9.5362 2.5291 58.0655 0.2705001339E+02 + 4 2 3 9.5362 2.5291 65.8200 0.1390387254E+03 + 4 2 4 9.5362 2.5291 92.0116 0.7269688252E+02 + 4 2 5 9.5362 2.5291 92.2178 0.3352457384E+02 + 4 2 6 9.5362 2.5291 105.8068 0.1280165544E+03 + 4 3 1 9.5362 3.9023 42.3397 0.5137983042E+02 + 4 3 2 9.5362 3.9023 58.0655 0.2705001339E+02 + 4 3 3 9.5362 3.9023 65.8200 0.1390387254E+03 + 4 3 4 9.5362 3.9023 92.0116 0.7269688252E+02 + 4 3 5 9.5362 3.9023 92.2178 0.3352457384E+02 + 4 3 6 9.5362 3.9023 105.8068 0.1280165544E+03 + 4 4 1 9.5362 7.3625 42.3397 0.5137983042E+02 + 4 4 2 9.5362 7.3625 58.0655 0.2705001339E+02 + 4 4 3 9.5362 7.3625 65.8200 0.1390387254E+03 + 4 4 4 9.5362 7.3625 92.0116 0.7269688252E+02 + 4 4 5 9.5362 7.3625 92.2178 0.3352457384E+02 + 4 4 6 9.5362 7.3625 105.8068 0.1280165544E+03 ------------------------------------------------------------------------------ =================================================================== Memory usage: VmHWM = 31Mb - VmPeak = 305Mb + VmPeak = 306Mb =================================================================== Unfolding on the coarse grid - dvanqq2 : 0.26s CPU 0.26s WALL ( 28 calls) - elphon_wrap : 14.45s CPU 14.67s WALL ( 1 calls) + dvanqq2 : 0.24s CPU 0.25s WALL ( 27 calls) + elphon_wrap : 13.97s CPU 14.14s WALL ( 1 calls) INITIALIZATION: init_vloc : 0.00s CPU 0.00s WALL ( 1 calls) - init_us_1 : 0.29s CPU 0.29s WALL ( 4 calls) + init_us_1 : 0.28s CPU 0.28s WALL ( 4 calls) newd : 0.00s CPU 0.00s WALL ( 1 calls) + dvanqq2 : 0.24s CPU 0.25s WALL ( 27 calls) Electron-Phonon interpolation - ephwann : 0.72s CPU 0.75s WALL ( 1 calls) + ephwann : 0.71s CPU 0.73s WALL ( 1 calls) ep-interp : 0.02s CPU 0.02s WALL ( 4 calls) Ham: step 1 : 0.00s CPU 0.00s WALL ( 1 calls) - Ham: step 2 : 0.00s CPU 0.00s WALL ( 1 calls) + Ham: step 2 : 0.00s CPU 0.01s WALL ( 1 calls) ep: step 1 : 0.00s CPU 0.00s WALL ( 162 calls) ep: step 2 : 0.05s CPU 0.06s WALL ( 162 calls) DynW2B : 0.00s CPU 0.00s WALL ( 4 calls) @@ -692,7 +692,7 @@ Total program execution - EPW : 17.52s CPU 17.80s WALL + EPW : 16.99s CPU 17.19s WALL Please consider citing: diff --git a/test-suite/epw_trev_uspp/epw1.in b/test-suite/epw_trev_uspp/epw1.in index f398845ba1..55bc6654c8 100644 --- a/test-suite/epw_trev_uspp/epw1.in +++ b/test-suite/epw_trev_uspp/epw1.in @@ -1,8 +1,6 @@ -- &inputepw prefix = 'sic' - amass(1) = 28.0855 - amass(2) = 12.0107 outdir = './' dvscf_dir = './save' @@ -17,10 +15,25 @@ wannierize = .true. nbndsub = 4 nbndskip = 0 - num_iter = 300 - proj(1) = 'Si:sp3' + dis_win_max = 12 + dis_froz_max= 9.2 + proj(1) = 'f= 0.000, 0.000, 0.000, : sp3' + wdata(1) = 'bands_plot = .true.' + wdata(2) = 'begin kpoint_path' + wdata(3) = 'G 0.000 0.000 0.000 X 0.500 0.000 0.500' + wdata(4) = 'X 0.500 0.000 0.500 W 0.500 0.250 0.750' + wdata(5) = 'W 0.500 0.250 0.750 L 0.500 0.500 0.500' + wdata(6) = 'L 0.500 0.500 0.500 K 0.375 0.375 0.750' + wdata(7) = 'K 0.375 0.375 0.750 G 0.000 0.000 0.000' + wdata(8) = 'G 0.000 0.000 0.000 L 0.500 0.500 0.500' + wdata(9) = 'end kpoint_path' + wdata(10) = 'bands_plot_format = gnuplot' + wdata(11) = 'guiding_centres = .true.' + wdata(12) = 'dis_num_iter = 500' + wdata(13) = 'num_print_cycles = 50' use_ws = .true. + vme = .true. elecselfen = .false. phonselfen = .false. From efb97211c4fa2399d1b480313987d7961ebf2156 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Wed, 17 Jul 2019 16:55:45 +0200 Subject: [PATCH 77/95] Unexpected side effects of removal of "input_parameters" in phonon: it is used in an obscure and nonlocal way. Reverted for the time being. Some more cleanupo here and there --- CPV/src/cp_restart_new.f90 | 2 +- Modules/qexsd.f90 | 2 +- Modules/qexsd_copy.f90 | 1 - Modules/read_namelists.f90 | 7 +++---- PHonon/PH/bcast_ph_input.f90 | 2 +- PHonon/PH/openfilq.f90 | 2 +- PHonon/PH/phq_readin.f90 | 3 ++- PP/src/open_grid.f90 | 11 +++++------ 8 files changed, 14 insertions(+), 16 deletions(-) diff --git a/CPV/src/cp_restart_new.f90 b/CPV/src/cp_restart_new.f90 index efb575413c..86db1208a5 100644 --- a/CPV/src/cp_restart_new.f90 +++ b/CPV/src/cp_restart_new.f90 @@ -95,7 +95,7 @@ SUBROUTINE cp_writefile( ndw, ascii, nfi, simtime, acc, nk, xk, & USE tsvdw_module, ONLY : vdw_isolated, vdw_econv_thr USE wrappers, ONLY : f_copy USE uspp, ONLY : okvan - USE input_parameters, ONLY : vdw_corr, london, starting_ns_eigenvalue + USE input_parameters, ONLY : vdw_corr, starting_ns_eigenvalue USE qexsd_module, ONLY: qexsd_init_vdw, qexsd_init_hybrid, qexsd_init_dftU USE qexsd_input, ONLY: qexsd_init_k_points_ibz diff --git a/Modules/qexsd.f90 b/Modules/qexsd.f90 index 0373a9424b..f7e1dc8c48 100644 --- a/Modules/qexsd.f90 +++ b/Modules/qexsd.f90 @@ -1378,7 +1378,7 @@ SUBROUTINE qexsd_init_berryPhaseOutput( obj, gpar, gvec, nppstr, nkort, xk, pdl_ ! USE ions_base, ONLY: nat, tau, atm, zv, ityp USE cell_base, ONLY: omega - USE noncollin_module, ONLY : noncolin, nspin_lsda + USE noncollin_module, ONLY: nspin_lsda IMPLICIT NONE ! TYPE (berryPhaseOutput_type) :: obj diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 94798c8057..1b8e0aebab 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -131,7 +131,6 @@ SUBROUTINE qexsd_copy_atomic_structure (atomic_structure, nsp, atm, & !-------------------------------------------------------------------------- USE qes_types_module, ONLY : atomic_structure_type - USE constants, ONLY : pi ! IMPLICIT NONE ! diff --git a/Modules/read_namelists.f90 b/Modules/read_namelists.f90 index 803acf2437..02b7347e6a 100644 --- a/Modules/read_namelists.f90 +++ b/Modules/read_namelists.f90 @@ -30,12 +30,11 @@ MODULE read_namelists_module REAL(DP), PARAMETER :: sm_not_set = -20.0_DP ! PUBLIC :: read_namelists, sm_not_set - ! - ! ... modules needed by read_xml.f90 - ! + PUBLIC :: check_namelist_read ! made public upon request of A.Jay + ! FIXME: should the following ones be public? PUBLIC :: control_defaults, system_defaults, & electrons_defaults, wannier_ac_defaults, ions_defaults, & - cell_defaults, press_ai_defaults, wannier_defaults, control_bcast, & + cell_defaults, press_ai_defaults, wannier_defaults, control_bcast,& system_bcast, electrons_bcast, ions_bcast, cell_bcast, & press_ai_bcast, wannier_bcast, wannier_ac_bcast, control_checkin, & system_checkin, electrons_checkin, ions_checkin, cell_checkin, & diff --git a/PHonon/PH/bcast_ph_input.f90 b/PHonon/PH/bcast_ph_input.f90 index 0aab6b465c..4b454872a7 100644 --- a/PHonon/PH/bcast_ph_input.f90 +++ b/PHonon/PH/bcast_ph_input.f90 @@ -32,7 +32,7 @@ subroutine bcast_ph_input ( ) USE control_flags, only: iverbosity, modenum USE ramanm, ONLY: lraman, elop, dek, eth_rps, eth_ns USE check_stop, ONLY: max_seconds - USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3 + USE input_parameters, ONLY : nk1, nk2, nk3, k1, k2, k3 USE ions_base, ONLY : amass USE io_global, ONLY : meta_ionode_id USE run_info, ONLY : title diff --git a/PHonon/PH/openfilq.f90 b/PHonon/PH/openfilq.f90 index b1e1abeac4..7cdb9b6539 100644 --- a/PHonon/PH/openfilq.f90 +++ b/PHonon/PH/openfilq.f90 @@ -41,7 +41,7 @@ SUBROUTINE openfilq() USE buffers, ONLY : open_buffer, close_buffer USE ramanm, ONLY : lraman, elop, iuchf, iud2w, iuba2, lrchf, lrd2w, lrba2 USE acfdtest, ONLY : acfdt_is_active, acfdt_num_der - USE start_k, ONLY : nk1, nk2, nk3 + USE input_parameters,ONLY : nk1, nk2, nk3 USE el_phon, ONLY : elph, elph_mat, iunwfcwann, lrwfcr USE dfile_star, ONLY : dvscf_star USE dfile_autoname, ONLY : dfile_name diff --git a/PHonon/PH/phq_readin.f90 b/PHonon/PH/phq_readin.f90 index 930f6e43d5..0880442277 100644 --- a/PHonon/PH/phq_readin.f90 +++ b/PHonon/PH/phq_readin.f90 @@ -22,7 +22,8 @@ SUBROUTINE phq_readin() USE mp_world, ONLY : world_comm USE ions_base, ONLY : amass, atm USE check_stop, ONLY : max_seconds - USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3, reset_grid + USE input_parameters, ONLY : nk1, nk2, nk3, k1, k2, k3 + USE start_k, ONLY : reset_grid USE klist, ONLY : xk, nks, nkstot, lgauss, two_fermi_energies, ltetra USE control_flags, ONLY : gamma_only, tqr, restart, io_level, & ts_vdw, ldftd3, lxdm diff --git a/PP/src/open_grid.f90 b/PP/src/open_grid.f90 index b84a6ec6cc..8c65e9ad4a 100644 --- a/PP/src/open_grid.f90 +++ b/PP/src/open_grid.f90 @@ -30,7 +30,6 @@ PROGRAM open_grid USE scf, ONLY : rho USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization USE io_rho_xml, ONLY : write_scf - USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3 USE noncollin_module, ONLY : nspin_mag, npol USE fft_interfaces, ONLY : fwfft ! @@ -56,7 +55,7 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) INTEGER :: ios, ik, ibnd, ik_idx, ik_idx_kpt, ik_idx_exx, is, na CHARACTER(len=4) :: spin_component CHARACTER(len=256) :: outdir - !INTEGER :: nq(3) + INTEGER :: k1, k2, k3 LOGICAL :: exst, opnd, exst_mem, magnetic_sym REAL(DP),ALLOCATABLE :: et0(:,:), wg0(:,:), yk(:,:), wk0(:) INTEGER, EXTERNAL :: n_plane_waves @@ -211,10 +210,10 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) DEALLOCATE(psic, et0, wg0) ! ! reconstruct input variables - nk1 = nq1 - nk2 = nq2 - nk3 = nq3 - CALL init_start_k(nk1,nk2,nk3, k1, k2, k3, "automatic",nks/nspin_lsda, xk, wk) + k1 = 0 + k2 = 0 + k3 = 0 + CALL init_start_k(nq1,nq2,nq3, k1, k2, k3, "automatic",nks/nspin_lsda, xk, wk) ! ! Restore EXX variables use_ace = use_ace_back From 63a9bc6636be27ddc781af5aac4e14f4be166468 Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Wed, 17 Jul 2019 17:50:12 +0200 Subject: [PATCH 78/95] Initialization of energy and potential in xc_drivers added --- Modules/xc_gga_drivers.f90 | 4 ++++ Modules/xc_lda_lsda_drivers.f90 | 3 +++ Modules/xc_mgga_drivers.f90 | 3 +++ 3 files changed, 10 insertions(+) diff --git a/Modules/xc_gga_drivers.f90 b/Modules/xc_gga_drivers.f90 index 736e3cb038..5dec96eae6 100644 --- a/Modules/xc_gga_drivers.f90 +++ b/Modules/xc_gga_drivers.f90 @@ -114,6 +114,10 @@ SUBROUTINE xc_gcx( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud ) igcx = get_igcx() igcc = get_igcc() ! + ex = 0.0_DP ; v1x = 0.0_DP ; v2x = 0.0_DP + ec = 0.0_DP ; v1c = 0.0_DP ; v2c = 0.0_DP + IF ( PRESENT(v2c_ud) ) v2c_ud = 0.0_DP + ! #if defined(__LIBXC) ! POLARIZED = .FALSE. diff --git a/Modules/xc_lda_lsda_drivers.f90 b/Modules/xc_lda_lsda_drivers.f90 index 4afec47c0a..8e5d82c39d 100644 --- a/Modules/xc_lda_lsda_drivers.f90 +++ b/Modules/xc_lda_lsda_drivers.f90 @@ -95,6 +95,9 @@ SUBROUTINE xc( length, sr_d, sv_d, rho_in, ex_out, ec_out, vx_out, vc_out ) iexch = get_iexch() icorr = get_icorr() ! + ex_out = 0.0_DP ; vx_out = 0.0_DP + ec_out = 0.0_DP ; vc_out = 0.0_DP + ! #if defined(__LIBXC) ! IF ( ANY(is_libxc(1:2)) ) THEN diff --git a/Modules/xc_mgga_drivers.f90 b/Modules/xc_mgga_drivers.f90 index 4cb998a5da..7579b26119 100644 --- a/Modules/xc_mgga_drivers.f90 +++ b/Modules/xc_mgga_drivers.f90 @@ -106,6 +106,9 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1 imeta = get_meta() imetac = get_metac() ! + ex = 0.0_DP ; v1x = 0.0_DP ; v2x = 0.0_DP ; v3x = 0.0_DP + ec = 0.0_DP ; v1c = 0.0_DP ; v2c = 0.0_DP ; v3c = 0.0_DP + ! POLARIZED = .FALSE. IF (ns == 2) THEN POLARIZED = .TRUE. From 8183b7ecb03f40ef019e185836918d804663a1d4 Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Thu, 18 Jul 2019 07:43:42 +0200 Subject: [PATCH 79/95] Dumb compilation error --- PP/src/open_grid.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PP/src/open_grid.f90 b/PP/src/open_grid.f90 index 8c65e9ad4a..1811f88ff8 100644 --- a/PP/src/open_grid.f90 +++ b/PP/src/open_grid.f90 @@ -229,7 +229,7 @@ SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) yk = xk CALL cryst_to_cart(nks, yk, at, -1) WRITE(stdout,'(5x,a)') "Grid of q-points" - WRITE(stdout,'(5x,a,3i4)') "Dimensions:", nk1, nk2, nk3 + WRITE(stdout,'(5x,a,3i4)') "Dimensions:", nq1, nq2, nq3 WRITE(stdout,'(5x,a,3i4)') "Shift: ", k1,k2,k3 WRITE(stdout,'(5x,a)') "List to be put in the .win file of wannier90: & &(already in crystal/fractionary coordinates):" From 7524ce148345db130c94ffb15d26c46b40acf5da Mon Sep 17 00:00:00 2001 From: Samuel Ponce Date: Thu, 18 Jul 2019 11:32:42 +0100 Subject: [PATCH 80/95] Modify the Si psp for the USPP test in EPW. Indeed the Si psp was a NC psp and not USPP. Now both are USPP. --- .../benchmark.out.git.inp=epw1.in.args=3 | 494 +++--- .../benchmark.out.git.inp=nscf.in.args=1 | 238 +-- .../benchmark.out.git.inp=ph.in.args=2 | 1487 +++++++++-------- .../benchmark.out.git.inp=scf.in.args=1 | 220 ++- test-suite/epw_trev_uspp/nscf.in | 2 +- test-suite/epw_trev_uspp/scf.in | 2 +- 6 files changed, 1315 insertions(+), 1128 deletions(-) diff --git a/test-suite/epw_trev_uspp/benchmark.out.git.inp=epw1.in.args=3 b/test-suite/epw_trev_uspp/benchmark.out.git.inp=epw1.in.args=3 index f491f7b589..58e25512b5 100644 --- a/test-suite/epw_trev_uspp/benchmark.out.git.inp=epw1.in.args=3 +++ b/test-suite/epw_trev_uspp/benchmark.out.git.inp=epw1.in.args=3 @@ -27,7 +27,7 @@ Comput. Phys. Commun. 209, 116 (2016) - Program EPW v.5.1.0 starts on 17Jul2019 at 12:13:57 + Program EPW v.5.1.0 starts on 18Jul2019 at 11:28:25 This program is part of the open-source Quantum ESPRESSO suite for quantum simulation of materials; please cite @@ -58,6 +58,8 @@ Sum 283 283 97 3119 3119 645 + Check: negative core charge= -0.000002 + -- bravais-lattice index = 2 @@ -128,14 +130,17 @@ k( 27) = ( -0.6666667 0.6666667 0.6666667), wk = 0.0740741 PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -149,9 +154,9 @@ l(4) = 1 Q(r) pseudized with 0 coefficients - EPW : 0.27s CPU 0.28s WALL + EPW : 0.55s CPU 0.59s WALL - EPW : 0.32s CPU 0.33s WALL + EPW : 0.65s CPU 0.69s WALL No wavefunction gauge setting applied ------------------------------------------------------------------- @@ -247,13 +252,13 @@ Wannier Function centers (cartesian, alat) and spreads (ang): - ( 0.16235 0.16235 0.16235) : 0.87049 - ( 0.16235 -0.16235 -0.16235) : 0.87049 - ( -0.16235 0.16235 -0.16235) : 0.87049 - ( -0.16235 -0.16235 0.16235) : 0.87049 + ( 0.16227 0.16227 0.16227) : 0.87291 + ( 0.16227 -0.16227 -0.16227) : 0.87291 + ( -0.16227 0.16227 -0.16227) : 0.87291 + ( -0.16227 -0.16227 0.16227) : 0.87291 ------------------------------------------------------------------- - WANNIER : 1.99s CPU 1.99s WALL ( 1 calls) + WANNIER : 2.16s CPU 2.17s WALL ( 1 calls) ------------------------------------------------------------------- Calculating kgmap @@ -386,8 +391,8 @@ Writing Hamiltonian, Dynamical matrix and EP vertex in Wann rep to file =================================================================== - Memory usage: VmHWM = 30Mb - VmPeak = 302Mb + Memory usage: VmHWM = 32Mb + VmPeak = 304Mb =================================================================== Using q-mesh file: pathq.dat @@ -399,14 +404,14 @@ Fermi energy coarse grid = 0.000000 eV - Fermi energy is calculated from the fine k-mesh: Ef = 9.578278 eV + Fermi energy is calculated from the fine k-mesh: Ef = 9.558074 eV Warning: check if difference with Fermi level fine grid makes sense =================================================================== - ibndmin = 2 ebndmin = 0.701 - ibndmax = 4 ebndmax = 0.701 + ibndmin = 2 ebndmin = 0.699 + ibndmax = 4 ebndmax = 0.699 Number of ep-matrix elements per pool : 54 ~= 0.42 Kb (@ 8 bytes/ DP) @@ -418,60 +423,60 @@ ik = 1 coord.: 0.0000000 0.0000000 0.0000000 ibnd jbnd imode enk[eV] enk+q[eV] omega(q)[meV] |g|[meV] ------------------------------------------------------------------------------ - 2 2 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 2 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 2 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 2 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 2 2 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 2 2 6 9.5362 9.5362 96.9696 0.1152035784E+03 - 2 3 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 3 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 3 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 3 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 2 3 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 2 3 6 9.5362 9.5362 96.9696 0.1152035784E+03 - 2 4 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 4 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 4 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 2 4 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 2 4 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 2 4 6 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 2 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 2 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 2 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 2 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 2 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 2 6 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 3 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 3 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 3 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 3 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 3 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 3 6 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 4 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 4 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 4 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 3 4 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 4 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 3 4 6 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 2 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 2 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 2 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 2 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 2 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 2 6 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 3 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 3 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 3 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 3 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 3 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 3 6 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 4 1 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 4 2 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 4 3 9.5362 9.5362 0.0000 0.3519101343E+02 - 4 4 4 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 4 5 9.5362 9.5362 96.9696 0.1152035784E+03 - 4 4 6 9.5362 9.5362 96.9696 0.1152035784E+03 + 2 2 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 2 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 2 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 2 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 2 2 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 2 2 6 9.5160 9.5160 97.7200 0.1133830465E+03 + 2 3 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 3 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 3 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 3 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 2 3 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 2 3 6 9.5160 9.5160 97.7200 0.1133830465E+03 + 2 4 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 4 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 4 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 2 4 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 2 4 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 2 4 6 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 2 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 2 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 2 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 2 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 2 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 2 6 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 3 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 3 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 3 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 3 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 3 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 3 6 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 4 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 4 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 4 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 3 4 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 4 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 3 4 6 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 2 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 2 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 2 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 2 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 2 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 2 6 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 3 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 3 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 3 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 3 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 3 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 3 6 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 4 1 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 4 2 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 4 3 9.5160 9.5160 0.0000 0.7105156944E+02 + 4 4 4 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 4 5 9.5160 9.5160 97.7200 0.1133830465E+03 + 4 4 6 9.5160 9.5160 97.7200 0.1133830465E+03 ------------------------------------------------------------------------------ Electron-phonon vertex |g| (meV) @@ -480,60 +485,60 @@ ik = 1 coord.: 0.0000000 0.0000000 0.0000000 ibnd jbnd imode enk[eV] enk+q[eV] omega(q)[meV] |g|[meV] ------------------------------------------------------------------------------ - 2 2 1 9.5362 3.3767 29.0461 0.2853406535E+02 - 2 2 2 9.5362 3.3767 29.0461 0.2853406535E+02 - 2 2 3 9.5362 3.3767 62.4893 0.1121901696E+03 - 2 2 4 9.5362 3.3767 94.2351 0.1032444000E+03 - 2 2 5 9.5362 3.3767 94.2351 0.1032444000E+03 - 2 2 6 9.5362 3.3767 109.2914 0.1372711279E+03 - 2 3 1 9.5362 8.6927 29.0461 0.2853406535E+02 - 2 3 2 9.5362 8.6927 29.0461 0.2853406535E+02 - 2 3 3 9.5362 8.6927 62.4893 0.1121901696E+03 - 2 3 4 9.5362 8.6927 94.2351 0.1032444000E+03 - 2 3 5 9.5362 8.6927 94.2351 0.1032444000E+03 - 2 3 6 9.5362 8.6927 109.2914 0.1372711279E+03 - 2 4 1 9.5362 8.6927 29.0461 0.2853406535E+02 - 2 4 2 9.5362 8.6927 29.0461 0.2853406535E+02 - 2 4 3 9.5362 8.6927 62.4893 0.1121901696E+03 - 2 4 4 9.5362 8.6927 94.2351 0.1032444000E+03 - 2 4 5 9.5362 8.6927 94.2351 0.1032444000E+03 - 2 4 6 9.5362 8.6927 109.2914 0.1372711279E+03 - 3 2 1 9.5362 3.3767 29.0461 0.2738064309E+02 - 3 2 2 9.5362 3.3767 29.0461 0.2738064309E+02 - 3 2 3 9.5362 3.3767 62.4893 0.1177059697E+03 - 3 2 4 9.5362 3.3767 94.2351 0.1139944117E+03 - 3 2 5 9.5362 3.3767 94.2351 0.1139944117E+03 - 3 2 6 9.5362 3.3767 109.2914 0.1409130214E+03 - 3 3 1 9.5362 8.6927 29.0461 0.2738064309E+02 - 3 3 2 9.5362 8.6927 29.0461 0.2738064309E+02 - 3 3 3 9.5362 8.6927 62.4893 0.1177059697E+03 - 3 3 4 9.5362 8.6927 94.2351 0.1139944117E+03 - 3 3 5 9.5362 8.6927 94.2351 0.1139944117E+03 - 3 3 6 9.5362 8.6927 109.2914 0.1409130214E+03 - 3 4 1 9.5362 8.6927 29.0461 0.2738064309E+02 - 3 4 2 9.5362 8.6927 29.0461 0.2738064309E+02 - 3 4 3 9.5362 8.6927 62.4893 0.1177059697E+03 - 3 4 4 9.5362 8.6927 94.2351 0.1139944117E+03 - 3 4 5 9.5362 8.6927 94.2351 0.1139944117E+03 - 3 4 6 9.5362 8.6927 109.2914 0.1409130214E+03 - 4 2 1 9.5362 3.3767 29.0461 0.2738064309E+02 - 4 2 2 9.5362 3.3767 29.0461 0.2738064309E+02 - 4 2 3 9.5362 3.3767 62.4893 0.1177059697E+03 - 4 2 4 9.5362 3.3767 94.2351 0.1139944117E+03 - 4 2 5 9.5362 3.3767 94.2351 0.1139944117E+03 - 4 2 6 9.5362 3.3767 109.2914 0.1409130214E+03 - 4 3 1 9.5362 8.6927 29.0461 0.2738064309E+02 - 4 3 2 9.5362 8.6927 29.0461 0.2738064309E+02 - 4 3 3 9.5362 8.6927 62.4893 0.1177059697E+03 - 4 3 4 9.5362 8.6927 94.2351 0.1139944117E+03 - 4 3 5 9.5362 8.6927 94.2351 0.1139944117E+03 - 4 3 6 9.5362 8.6927 109.2914 0.1409130214E+03 - 4 4 1 9.5362 8.6927 29.0461 0.2738064309E+02 - 4 4 2 9.5362 8.6927 29.0461 0.2738064309E+02 - 4 4 3 9.5362 8.6927 62.4893 0.1177059697E+03 - 4 4 4 9.5362 8.6927 94.2351 0.1139944117E+03 - 4 4 5 9.5362 8.6927 94.2351 0.1139944117E+03 - 4 4 6 9.5362 8.6927 109.2914 0.1409130214E+03 + 2 2 1 9.5160 3.3222 29.0824 0.2652520458E+02 + 2 2 2 9.5160 3.3222 29.0824 0.2652520458E+02 + 2 2 3 9.5160 3.3222 62.4456 0.1230957038E+03 + 2 2 4 9.5160 3.3222 94.9622 0.1220076049E+03 + 2 2 5 9.5160 3.3222 94.9622 0.1220076049E+03 + 2 2 6 9.5160 3.3222 109.8472 0.1427516895E+03 + 2 3 1 9.5160 8.6634 29.0824 0.2652520458E+02 + 2 3 2 9.5160 8.6634 29.0824 0.2652520458E+02 + 2 3 3 9.5160 8.6634 62.4456 0.1230957038E+03 + 2 3 4 9.5160 8.6634 94.9622 0.1220076049E+03 + 2 3 5 9.5160 8.6634 94.9622 0.1220076049E+03 + 2 3 6 9.5160 8.6634 109.8472 0.1427516895E+03 + 2 4 1 9.5160 8.6634 29.0824 0.2652520458E+02 + 2 4 2 9.5160 8.6634 29.0824 0.2652520458E+02 + 2 4 3 9.5160 8.6634 62.4456 0.1230957038E+03 + 2 4 4 9.5160 8.6634 94.9622 0.1220076049E+03 + 2 4 5 9.5160 8.6634 94.9622 0.1220076049E+03 + 2 4 6 9.5160 8.6634 109.8472 0.1427516895E+03 + 3 2 1 9.5160 3.3222 29.0824 0.2870864899E+02 + 3 2 2 9.5160 3.3222 29.0824 0.2870864899E+02 + 3 2 3 9.5160 3.3222 62.4456 0.1120403959E+03 + 3 2 4 9.5160 3.3222 94.9622 0.1020432439E+03 + 3 2 5 9.5160 3.3222 94.9622 0.1020432439E+03 + 3 2 6 9.5160 3.3222 109.8472 0.1358284440E+03 + 3 3 1 9.5160 8.6634 29.0824 0.2870864899E+02 + 3 3 2 9.5160 8.6634 29.0824 0.2870864899E+02 + 3 3 3 9.5160 8.6634 62.4456 0.1120403959E+03 + 3 3 4 9.5160 8.6634 94.9622 0.1020432439E+03 + 3 3 5 9.5160 8.6634 94.9622 0.1020432439E+03 + 3 3 6 9.5160 8.6634 109.8472 0.1358284440E+03 + 3 4 1 9.5160 8.6634 29.0824 0.2870864899E+02 + 3 4 2 9.5160 8.6634 29.0824 0.2870864899E+02 + 3 4 3 9.5160 8.6634 62.4456 0.1120403959E+03 + 3 4 4 9.5160 8.6634 94.9622 0.1020432439E+03 + 3 4 5 9.5160 8.6634 94.9622 0.1020432439E+03 + 3 4 6 9.5160 8.6634 109.8472 0.1358284440E+03 + 4 2 1 9.5160 3.3222 29.0824 0.2870864899E+02 + 4 2 2 9.5160 3.3222 29.0824 0.2870864899E+02 + 4 2 3 9.5160 3.3222 62.4456 0.1120403959E+03 + 4 2 4 9.5160 3.3222 94.9622 0.1020432439E+03 + 4 2 5 9.5160 3.3222 94.9622 0.1020432439E+03 + 4 2 6 9.5160 3.3222 109.8472 0.1358284440E+03 + 4 3 1 9.5160 8.6634 29.0824 0.2870864899E+02 + 4 3 2 9.5160 8.6634 29.0824 0.2870864899E+02 + 4 3 3 9.5160 8.6634 62.4456 0.1120403959E+03 + 4 3 4 9.5160 8.6634 94.9622 0.1020432439E+03 + 4 3 5 9.5160 8.6634 94.9622 0.1020432439E+03 + 4 3 6 9.5160 8.6634 109.8472 0.1358284440E+03 + 4 4 1 9.5160 8.6634 29.0824 0.2870864899E+02 + 4 4 2 9.5160 8.6634 29.0824 0.2870864899E+02 + 4 4 3 9.5160 8.6634 62.4456 0.1120403959E+03 + 4 4 4 9.5160 8.6634 94.9622 0.1020432439E+03 + 4 4 5 9.5160 8.6634 94.9622 0.1020432439E+03 + 4 4 6 9.5160 8.6634 109.8472 0.1358284440E+03 ------------------------------------------------------------------------------ Electron-phonon vertex |g| (meV) @@ -542,60 +547,60 @@ ik = 1 coord.: 0.0000000 0.0000000 0.0000000 ibnd jbnd imode enk[eV] enk+q[eV] omega(q)[meV] |g|[meV] ------------------------------------------------------------------------------ - 2 2 1 9.5362 4.5130 40.9082 0.2477307077E+02 - 2 2 2 9.5362 4.5130 40.9082 0.2477307077E+02 - 2 2 3 9.5362 4.5130 62.8657 0.1014416910E+03 - 2 2 4 9.5362 4.5130 93.7699 0.9348130446E+02 - 2 2 5 9.5362 4.5130 93.7699 0.9348130446E+02 - 2 2 6 9.5362 4.5130 109.2888 0.1287308185E+03 - 2 3 1 9.5362 6.9263 40.9082 0.2477307077E+02 - 2 3 2 9.5362 6.9263 40.9082 0.2477307077E+02 - 2 3 3 9.5362 6.9263 62.8657 0.1014416910E+03 - 2 3 4 9.5362 6.9263 93.7699 0.9348130446E+02 - 2 3 5 9.5362 6.9263 93.7699 0.9348130446E+02 - 2 3 6 9.5362 6.9263 109.2888 0.1287308185E+03 - 2 4 1 9.5362 6.9263 40.9082 0.2477307077E+02 - 2 4 2 9.5362 6.9263 40.9082 0.2477307077E+02 - 2 4 3 9.5362 6.9263 62.8657 0.1014416910E+03 - 2 4 4 9.5362 6.9263 93.7699 0.9348130446E+02 - 2 4 5 9.5362 6.9263 93.7699 0.9348130446E+02 - 2 4 6 9.5362 6.9263 109.2888 0.1287308185E+03 - 3 2 1 9.5362 4.5130 40.9082 0.2651779195E+02 - 3 2 2 9.5362 4.5130 40.9082 0.2651779195E+02 - 3 2 3 9.5362 4.5130 62.8657 0.1124393853E+03 - 3 2 4 9.5362 4.5130 93.7699 0.9062483731E+02 - 3 2 5 9.5362 4.5130 93.7699 0.9062483731E+02 - 3 2 6 9.5362 4.5130 109.2888 0.1417295666E+03 - 3 3 1 9.5362 6.9263 40.9082 0.2651779195E+02 - 3 3 2 9.5362 6.9263 40.9082 0.2651779195E+02 - 3 3 3 9.5362 6.9263 62.8657 0.1124393853E+03 - 3 3 4 9.5362 6.9263 93.7699 0.9062483731E+02 - 3 3 5 9.5362 6.9263 93.7699 0.9062483731E+02 - 3 3 6 9.5362 6.9263 109.2888 0.1417295666E+03 - 3 4 1 9.5362 6.9263 40.9082 0.2651779195E+02 - 3 4 2 9.5362 6.9263 40.9082 0.2651779195E+02 - 3 4 3 9.5362 6.9263 62.8657 0.1124393853E+03 - 3 4 4 9.5362 6.9263 93.7699 0.9062483731E+02 - 3 4 5 9.5362 6.9263 93.7699 0.9062483731E+02 - 3 4 6 9.5362 6.9263 109.2888 0.1417295666E+03 - 4 2 1 9.5362 4.5130 40.9082 0.2651779195E+02 - 4 2 2 9.5362 4.5130 40.9082 0.2651779195E+02 - 4 2 3 9.5362 4.5130 62.8657 0.1124393853E+03 - 4 2 4 9.5362 4.5130 93.7699 0.9062483731E+02 - 4 2 5 9.5362 4.5130 93.7699 0.9062483731E+02 - 4 2 6 9.5362 4.5130 109.2888 0.1417295666E+03 - 4 3 1 9.5362 6.9263 40.9082 0.2651779195E+02 - 4 3 2 9.5362 6.9263 40.9082 0.2651779195E+02 - 4 3 3 9.5362 6.9263 62.8657 0.1124393853E+03 - 4 3 4 9.5362 6.9263 93.7699 0.9062483731E+02 - 4 3 5 9.5362 6.9263 93.7699 0.9062483731E+02 - 4 3 6 9.5362 6.9263 109.2888 0.1417295666E+03 - 4 4 1 9.5362 6.9263 40.9082 0.2651779195E+02 - 4 4 2 9.5362 6.9263 40.9082 0.2651779195E+02 - 4 4 3 9.5362 6.9263 62.8657 0.1124393853E+03 - 4 4 4 9.5362 6.9263 93.7699 0.9062483731E+02 - 4 4 5 9.5362 6.9263 93.7699 0.9062483731E+02 - 4 4 6 9.5362 6.9263 109.2888 0.1417295666E+03 + 2 2 1 9.5160 4.4527 40.9402 0.2503203409E+02 + 2 2 2 9.5160 4.4527 40.9402 0.2503203409E+02 + 2 2 3 9.5160 4.4527 62.8224 0.1038382681E+03 + 2 2 4 9.5160 4.4527 94.4487 0.9178196864E+02 + 2 2 5 9.5160 4.4527 94.4487 0.9178196864E+02 + 2 2 6 9.5160 4.4527 109.8467 0.1301973057E+03 + 2 3 1 9.5160 6.8890 40.9402 0.2503203409E+02 + 2 3 2 9.5160 6.8890 40.9402 0.2503203409E+02 + 2 3 3 9.5160 6.8890 62.8224 0.1038382681E+03 + 2 3 4 9.5160 6.8890 94.4487 0.9178196864E+02 + 2 3 5 9.5160 6.8890 94.4487 0.9178196864E+02 + 2 3 6 9.5160 6.8890 109.8467 0.1301973057E+03 + 2 4 1 9.5160 6.8890 40.9402 0.2503203409E+02 + 2 4 2 9.5160 6.8890 40.9402 0.2503203409E+02 + 2 4 3 9.5160 6.8890 62.8224 0.1038382681E+03 + 2 4 4 9.5160 6.8890 94.4487 0.9178196864E+02 + 2 4 5 9.5160 6.8890 94.4487 0.9178196864E+02 + 2 4 6 9.5160 6.8890 109.8467 0.1301973057E+03 + 3 2 1 9.5160 4.4527 40.9402 0.2618277177E+02 + 3 2 2 9.5160 4.4527 40.9402 0.2618277177E+02 + 3 2 3 9.5160 4.4527 62.8224 0.1111840682E+03 + 3 2 4 9.5160 4.4527 94.4487 0.8996260816E+02 + 3 2 5 9.5160 4.4527 94.4487 0.8996260816E+02 + 3 2 6 9.5160 4.4527 109.8467 0.1387681792E+03 + 3 3 1 9.5160 6.8890 40.9402 0.2618277177E+02 + 3 3 2 9.5160 6.8890 40.9402 0.2618277177E+02 + 3 3 3 9.5160 6.8890 62.8224 0.1111840682E+03 + 3 3 4 9.5160 6.8890 94.4487 0.8996260816E+02 + 3 3 5 9.5160 6.8890 94.4487 0.8996260816E+02 + 3 3 6 9.5160 6.8890 109.8467 0.1387681792E+03 + 3 4 1 9.5160 6.8890 40.9402 0.2618277177E+02 + 3 4 2 9.5160 6.8890 40.9402 0.2618277177E+02 + 3 4 3 9.5160 6.8890 62.8224 0.1111840682E+03 + 3 4 4 9.5160 6.8890 94.4487 0.8996260816E+02 + 3 4 5 9.5160 6.8890 94.4487 0.8996260816E+02 + 3 4 6 9.5160 6.8890 109.8467 0.1387681792E+03 + 4 2 1 9.5160 4.4527 40.9402 0.2618277177E+02 + 4 2 2 9.5160 4.4527 40.9402 0.2618277177E+02 + 4 2 3 9.5160 4.4527 62.8224 0.1111840682E+03 + 4 2 4 9.5160 4.4527 94.4487 0.8996260816E+02 + 4 2 5 9.5160 4.4527 94.4487 0.8996260816E+02 + 4 2 6 9.5160 4.4527 109.8467 0.1387681792E+03 + 4 3 1 9.5160 6.8890 40.9402 0.2618277177E+02 + 4 3 2 9.5160 6.8890 40.9402 0.2618277177E+02 + 4 3 3 9.5160 6.8890 62.8224 0.1111840682E+03 + 4 3 4 9.5160 6.8890 94.4487 0.8996260816E+02 + 4 3 5 9.5160 6.8890 94.4487 0.8996260816E+02 + 4 3 6 9.5160 6.8890 109.8467 0.1387681792E+03 + 4 4 1 9.5160 6.8890 40.9402 0.2618277177E+02 + 4 4 2 9.5160 6.8890 40.9402 0.2618277177E+02 + 4 4 3 9.5160 6.8890 62.8224 0.1111840682E+03 + 4 4 4 9.5160 6.8890 94.4487 0.8996260816E+02 + 4 4 5 9.5160 6.8890 94.4487 0.8996260816E+02 + 4 4 6 9.5160 6.8890 109.8467 0.1387681792E+03 ------------------------------------------------------------------------------ Electron-phonon vertex |g| (meV) @@ -604,95 +609,96 @@ ik = 1 coord.: 0.0000000 0.0000000 0.0000000 ibnd jbnd imode enk[eV] enk+q[eV] omega(q)[meV] |g|[meV] ------------------------------------------------------------------------------ - 2 2 1 9.5362 2.5291 42.3397 0.4664118925E+02 - 2 2 2 9.5362 2.5291 58.0655 0.4993970589E+02 - 2 2 3 9.5362 2.5291 65.8200 0.1206035829E+03 - 2 2 4 9.5362 2.5291 92.0116 0.9092749278E+02 - 2 2 5 9.5362 2.5291 92.2178 0.4644773796E+02 - 2 2 6 9.5362 2.5291 105.8068 0.1046925861E+03 - 2 3 1 9.5362 3.9023 42.3397 0.4664118925E+02 - 2 3 2 9.5362 3.9023 58.0655 0.4993970589E+02 - 2 3 3 9.5362 3.9023 65.8200 0.1206035829E+03 - 2 3 4 9.5362 3.9023 92.0116 0.9092749278E+02 - 2 3 5 9.5362 3.9023 92.2178 0.4644773796E+02 - 2 3 6 9.5362 3.9023 105.8068 0.1046925861E+03 - 2 4 1 9.5362 7.3625 42.3397 0.4664118925E+02 - 2 4 2 9.5362 7.3625 58.0655 0.4993970589E+02 - 2 4 3 9.5362 7.3625 65.8200 0.1206035829E+03 - 2 4 4 9.5362 7.3625 92.0116 0.9092749278E+02 - 2 4 5 9.5362 7.3625 92.2178 0.4644773796E+02 - 2 4 6 9.5362 7.3625 105.8068 0.1046925861E+03 - 3 2 1 9.5362 2.5291 42.3397 0.4180598853E+02 - 3 2 2 9.5362 2.5291 58.0655 0.5300248882E+02 - 3 2 3 9.5362 2.5291 65.8200 0.1115028654E+03 - 3 2 4 9.5362 2.5291 92.0116 0.8015134537E+02 - 3 2 5 9.5362 2.5291 92.2178 0.4693935033E+02 - 3 2 6 9.5362 2.5291 105.8068 0.9008050165E+02 - 3 3 1 9.5362 3.9023 42.3397 0.4180598853E+02 - 3 3 2 9.5362 3.9023 58.0655 0.5300248882E+02 - 3 3 3 9.5362 3.9023 65.8200 0.1115028654E+03 - 3 3 4 9.5362 3.9023 92.0116 0.8015134537E+02 - 3 3 5 9.5362 3.9023 92.2178 0.4693935033E+02 - 3 3 6 9.5362 3.9023 105.8068 0.9008050165E+02 - 3 4 1 9.5362 7.3625 42.3397 0.4180598853E+02 - 3 4 2 9.5362 7.3625 58.0655 0.5300248882E+02 - 3 4 3 9.5362 7.3625 65.8200 0.1115028654E+03 - 3 4 4 9.5362 7.3625 92.0116 0.8015134537E+02 - 3 4 5 9.5362 7.3625 92.2178 0.4693935033E+02 - 3 4 6 9.5362 7.3625 105.8068 0.9008050165E+02 - 4 2 1 9.5362 2.5291 42.3397 0.5137983042E+02 - 4 2 2 9.5362 2.5291 58.0655 0.2705001339E+02 - 4 2 3 9.5362 2.5291 65.8200 0.1390387254E+03 - 4 2 4 9.5362 2.5291 92.0116 0.7269688252E+02 - 4 2 5 9.5362 2.5291 92.2178 0.3352457384E+02 - 4 2 6 9.5362 2.5291 105.8068 0.1280165544E+03 - 4 3 1 9.5362 3.9023 42.3397 0.5137983042E+02 - 4 3 2 9.5362 3.9023 58.0655 0.2705001339E+02 - 4 3 3 9.5362 3.9023 65.8200 0.1390387254E+03 - 4 3 4 9.5362 3.9023 92.0116 0.7269688252E+02 - 4 3 5 9.5362 3.9023 92.2178 0.3352457384E+02 - 4 3 6 9.5362 3.9023 105.8068 0.1280165544E+03 - 4 4 1 9.5362 7.3625 42.3397 0.5137983042E+02 - 4 4 2 9.5362 7.3625 58.0655 0.2705001339E+02 - 4 4 3 9.5362 7.3625 65.8200 0.1390387254E+03 - 4 4 4 9.5362 7.3625 92.0116 0.7269688252E+02 - 4 4 5 9.5362 7.3625 92.2178 0.3352457384E+02 - 4 4 6 9.5362 7.3625 105.8068 0.1280165544E+03 + 2 2 1 9.5160 2.4493 42.3930 0.4119151265E+02 + 2 2 2 9.5160 2.4493 58.0377 0.4478826552E+02 + 2 2 3 9.5160 2.4493 65.7519 0.1231646165E+03 + 2 2 4 9.5160 2.4493 92.7013 0.8959337007E+02 + 2 2 5 9.5160 2.4493 92.9890 0.5148654876E+02 + 2 2 6 9.5160 2.4493 106.3386 0.1205056911E+03 + 2 3 1 9.5160 3.8572 42.3930 0.4119151265E+02 + 2 3 2 9.5160 3.8572 58.0377 0.4478826552E+02 + 2 3 3 9.5160 3.8572 65.7519 0.1231646165E+03 + 2 3 4 9.5160 3.8572 92.7013 0.8959337007E+02 + 2 3 5 9.5160 3.8572 92.9890 0.5148654876E+02 + 2 3 6 9.5160 3.8572 106.3386 0.1205056911E+03 + 2 4 1 9.5160 7.3262 42.3930 0.4119151265E+02 + 2 4 2 9.5160 7.3262 58.0377 0.4478826552E+02 + 2 4 3 9.5160 7.3262 65.7519 0.1231646165E+03 + 2 4 4 9.5160 7.3262 92.7013 0.8959337007E+02 + 2 4 5 9.5160 7.3262 92.9890 0.5148654876E+02 + 2 4 6 9.5160 7.3262 106.3386 0.1205056911E+03 + 3 2 1 9.5160 2.4493 42.3930 0.5581128795E+02 + 3 2 2 9.5160 2.4493 58.0377 0.2765566519E+02 + 3 2 3 9.5160 2.4493 65.7519 0.1382234713E+03 + 3 2 4 9.5160 2.4493 92.7013 0.6599108425E+02 + 3 2 5 9.5160 2.4493 92.9890 0.2291371053E+02 + 3 2 6 9.5160 2.4493 106.3386 0.1190524613E+03 + 3 3 1 9.5160 3.8572 42.3930 0.5581128795E+02 + 3 3 2 9.5160 3.8572 58.0377 0.2765566519E+02 + 3 3 3 9.5160 3.8572 65.7519 0.1382234713E+03 + 3 3 4 9.5160 3.8572 92.7013 0.6599108425E+02 + 3 3 5 9.5160 3.8572 92.9890 0.2291371053E+02 + 3 3 6 9.5160 3.8572 106.3386 0.1190524613E+03 + 3 4 1 9.5160 7.3262 42.3930 0.5581128795E+02 + 3 4 2 9.5160 7.3262 58.0377 0.2765566519E+02 + 3 4 3 9.5160 7.3262 65.7519 0.1382234713E+03 + 3 4 4 9.5160 7.3262 92.7013 0.6599108425E+02 + 3 4 5 9.5160 7.3262 92.9890 0.2291371053E+02 + 3 4 6 9.5160 7.3262 106.3386 0.1190524613E+03 + 4 2 1 9.5160 2.4493 42.3930 0.4356854362E+02 + 4 2 2 9.5160 2.4493 58.0377 0.5721461718E+02 + 4 2 3 9.5160 2.4493 65.7519 0.1059348309E+03 + 4 2 4 9.5160 2.4493 92.7013 0.8358017184E+02 + 4 2 5 9.5160 2.4493 92.9890 0.4711678716E+02 + 4 2 6 9.5160 2.4493 106.3386 0.7812325717E+02 + 4 3 1 9.5160 3.8572 42.3930 0.4356854362E+02 + 4 3 2 9.5160 3.8572 58.0377 0.5721461718E+02 + 4 3 3 9.5160 3.8572 65.7519 0.1059348309E+03 + 4 3 4 9.5160 3.8572 92.7013 0.8358017184E+02 + 4 3 5 9.5160 3.8572 92.9890 0.4711678716E+02 + 4 3 6 9.5160 3.8572 106.3386 0.7812325717E+02 + 4 4 1 9.5160 7.3262 42.3930 0.4356854362E+02 + 4 4 2 9.5160 7.3262 58.0377 0.5721461718E+02 + 4 4 3 9.5160 7.3262 65.7519 0.1059348309E+03 + 4 4 4 9.5160 7.3262 92.7013 0.8358017184E+02 + 4 4 5 9.5160 7.3262 92.9890 0.4711678716E+02 + 4 4 6 9.5160 7.3262 106.3386 0.7812325717E+02 ------------------------------------------------------------------------------ =================================================================== - Memory usage: VmHWM = 31Mb - VmPeak = 306Mb + Memory usage: VmHWM = 32Mb + VmPeak = 308Mb =================================================================== Unfolding on the coarse grid - dvanqq2 : 0.24s CPU 0.25s WALL ( 27 calls) - elphon_wrap : 13.97s CPU 14.14s WALL ( 1 calls) + dvanqq2 : 0.46s CPU 0.46s WALL ( 27 calls) + elphon_wrap : 16.11s CPU 16.23s WALL ( 1 calls) INITIALIZATION: + set_drhoc : 1.05s CPU 1.05s WALL ( 28 calls) init_vloc : 0.00s CPU 0.00s WALL ( 1 calls) - init_us_1 : 0.28s CPU 0.28s WALL ( 4 calls) + init_us_1 : 0.64s CPU 0.64s WALL ( 4 calls) newd : 0.00s CPU 0.00s WALL ( 1 calls) - dvanqq2 : 0.24s CPU 0.25s WALL ( 27 calls) + dvanqq2 : 0.46s CPU 0.46s WALL ( 27 calls) Electron-Phonon interpolation - ephwann : 0.71s CPU 0.73s WALL ( 1 calls) + ephwann : 0.70s CPU 0.73s WALL ( 1 calls) ep-interp : 0.02s CPU 0.02s WALL ( 4 calls) Ham: step 1 : 0.00s CPU 0.00s WALL ( 1 calls) - Ham: step 2 : 0.00s CPU 0.01s WALL ( 1 calls) + Ham: step 2 : 0.00s CPU 0.00s WALL ( 1 calls) ep: step 1 : 0.00s CPU 0.00s WALL ( 162 calls) - ep: step 2 : 0.05s CPU 0.06s WALL ( 162 calls) + ep: step 2 : 0.05s CPU 0.05s WALL ( 162 calls) DynW2B : 0.00s CPU 0.00s WALL ( 4 calls) HamW2B : 0.00s CPU 0.00s WALL ( 15 calls) ephW2Bp : 0.02s CPU 0.02s WALL ( 4 calls) Total program execution - EPW : 16.99s CPU 17.19s WALL + EPW : 19.62s CPU 19.82s WALL Please consider citing: diff --git a/test-suite/epw_trev_uspp/benchmark.out.git.inp=nscf.in.args=1 b/test-suite/epw_trev_uspp/benchmark.out.git.inp=nscf.in.args=1 index 280dc5bf81..e2cd848a78 100644 --- a/test-suite/epw_trev_uspp/benchmark.out.git.inp=nscf.in.args=1 +++ b/test-suite/epw_trev_uspp/benchmark.out.git.inp=nscf.in.args=1 @@ -1,5 +1,5 @@ - Program PWSCF v.6.3 starts on 18Jan2019 at 19: 6:15 + Program PWSCF v.6.4.1 starts on 18Jul2019 at 11:28:23 This program is part of the open-source Quantum ESPRESSO suite for quantum simulation of materials; please cite @@ -21,7 +21,7 @@ Max angular momentum in pseudopotentials (lmaxx) = 3 Atomic positions and unit cell read from directory: - ./sic.save/ + ./sic.save/ file C.pbe-rrkjus.UPF: wavefunction(s) 2S 2P renormalized @@ -45,7 +45,8 @@ number of Kohn-Sham states= 4 kinetic-energy cutoff = 30.0000 Ry charge density cutoff = 120.0000 Ry - Exchange-correlation = SLA PW PBE PBE ( 1 4 3 4 0 0) + Exchange-correlation= SLA PW PBE PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.237000 celldm(2)= 0.000000 celldm(3)= 0.000000 celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000 @@ -62,14 +63,17 @@ PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -462,7 +466,7 @@ T_2 3.00 0.00 -1.00 -1.00 1.00 Dynamical RAM for local pot: 0.00 MB - Dynamical RAM for nlocal pot: 0.08 MB + Dynamical RAM for nlocal pot: 0.09 MB Dynamical RAM for qrad: 0.66 MB @@ -484,9 +488,11 @@ T_2 3.00 0.00 -1.00 -1.00 1.00 Dynamical RAM for addusdens: 2.09 MB - Estimated static dynamical RAM per process > 2.19 MB + Estimated static dynamical RAM per process > 2.20 MB - Estimated max dynamical RAM per process > 4.28 MB + Estimated max dynamical RAM per process > 4.30 MB + + Check: negative core charge= -0.000002 The potential is recalculated from file : ./sic.save/charge-density @@ -496,298 +502,298 @@ T_2 3.00 0.00 -1.00 -1.00 1.00 Band Structure Calculation Davidson diagonalization with overlap - Computing kpt #: 1 - total cpu time spent up to now is 0.3 secs + Computing kpt #: 1 of 27 + total cpu time spent up to now is 0.6 secs - Computing kpt #: 2 - total cpu time spent up to now is 0.3 secs + Computing kpt #: 2 of 27 + total cpu time spent up to now is 0.6 secs - Computing kpt #: 3 - total cpu time spent up to now is 0.3 secs + Computing kpt #: 3 of 27 + total cpu time spent up to now is 0.6 secs - Computing kpt #: 4 - total cpu time spent up to now is 0.3 secs + Computing kpt #: 4 of 27 + total cpu time spent up to now is 0.6 secs - Computing kpt #: 5 - total cpu time spent up to now is 0.3 secs + Computing kpt #: 5 of 27 + total cpu time spent up to now is 0.6 secs - Computing kpt #: 6 - total cpu time spent up to now is 0.4 secs + Computing kpt #: 6 of 27 + total cpu time spent up to now is 0.7 secs - Computing kpt #: 7 - total cpu time spent up to now is 0.4 secs + Computing kpt #: 7 of 27 + total cpu time spent up to now is 0.7 secs - Computing kpt #: 8 - total cpu time spent up to now is 0.4 secs + Computing kpt #: 8 of 27 + total cpu time spent up to now is 0.7 secs - Computing kpt #: 9 - total cpu time spent up to now is 0.4 secs + Computing kpt #: 9 of 27 + total cpu time spent up to now is 0.7 secs - Computing kpt #: 10 - total cpu time spent up to now is 0.4 secs + Computing kpt #: 10 of 27 + total cpu time spent up to now is 0.7 secs - Computing kpt #: 11 - total cpu time spent up to now is 0.4 secs + Computing kpt #: 11 of 27 + total cpu time spent up to now is 0.7 secs - Computing kpt #: 12 - total cpu time spent up to now is 0.5 secs + Computing kpt #: 12 of 27 + total cpu time spent up to now is 0.8 secs - Computing kpt #: 13 - total cpu time spent up to now is 0.5 secs + Computing kpt #: 13 of 27 + total cpu time spent up to now is 0.8 secs - Computing kpt #: 14 - total cpu time spent up to now is 0.5 secs + Computing kpt #: 14 of 27 + total cpu time spent up to now is 0.8 secs - Computing kpt #: 15 - total cpu time spent up to now is 0.5 secs + Computing kpt #: 15 of 27 + total cpu time spent up to now is 0.8 secs - Computing kpt #: 16 - total cpu time spent up to now is 0.5 secs + Computing kpt #: 16 of 27 + total cpu time spent up to now is 0.8 secs - Computing kpt #: 17 - total cpu time spent up to now is 0.5 secs + Computing kpt #: 17 of 27 + total cpu time spent up to now is 0.8 secs - Computing kpt #: 18 - total cpu time spent up to now is 0.6 secs + Computing kpt #: 18 of 27 + total cpu time spent up to now is 0.9 secs - Computing kpt #: 19 - total cpu time spent up to now is 0.6 secs + Computing kpt #: 19 of 27 + total cpu time spent up to now is 0.9 secs - Computing kpt #: 20 - total cpu time spent up to now is 0.6 secs + Computing kpt #: 20 of 27 + total cpu time spent up to now is 0.9 secs - Computing kpt #: 21 - total cpu time spent up to now is 0.6 secs + Computing kpt #: 21 of 27 + total cpu time spent up to now is 0.9 secs - Computing kpt #: 22 - total cpu time spent up to now is 0.6 secs + Computing kpt #: 22 of 27 + total cpu time spent up to now is 0.9 secs - Computing kpt #: 23 - total cpu time spent up to now is 0.6 secs + Computing kpt #: 23 of 27 + total cpu time spent up to now is 0.9 secs - Computing kpt #: 24 - total cpu time spent up to now is 0.6 secs + Computing kpt #: 24 of 27 + total cpu time spent up to now is 1.0 secs - Computing kpt #: 25 - total cpu time spent up to now is 0.7 secs + Computing kpt #: 25 of 27 + total cpu time spent up to now is 1.0 secs - Computing kpt #: 26 - total cpu time spent up to now is 0.7 secs + Computing kpt #: 26 of 27 + total cpu time spent up to now is 1.0 secs - Computing kpt #: 27 - total cpu time spent up to now is 0.7 secs + Computing kpt #: 27 of 27 + total cpu time spent up to now is 1.0 secs - ethr = 1.25E-12, avg # of iterations = 13.3 + ethr = 1.25E-12, avg # of iterations = 14.4 - total cpu time spent up to now is 0.7 secs + total cpu time spent up to now is 1.0 secs End of band structure calculation k = 0.0000 0.0000 0.0000 ( 387 PWs) bands (ev): - -5.8255 9.5362 9.5362 9.5362 + -5.8991 9.5160 9.5160 9.5160 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.3333 0.3333-0.3333 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.6667 0.6667-0.6667 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.3333 0.3333 0.3333 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.0000 0.6667 0.0000 ( 387 PWs) bands (ev): - -3.0527 4.5130 6.9263 6.9263 + -3.1193 4.4527 6.8890 6.8890 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.3333 1.0000-0.3333 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.6667 0.6667 0.6667 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.3333 1.0000 0.3333 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.0000 1.3333 0.0000 ( 387 PWs) bands (ev): - -3.0527 4.5130 6.9263 6.9263 + -3.1193 4.4527 6.8890 6.8890 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.3333-0.3333 0.3333 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.6667 0.0000 0.0000 ( 387 PWs) bands (ev): - -3.0527 4.5130 6.9263 6.9263 + -3.1193 4.4527 6.8890 6.8890 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-1.0000 0.3333-0.3333 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.0000 0.0000 0.6667 ( 387 PWs) bands (ev): - -3.0527 4.5130 6.9263 6.9263 + -3.1193 4.4527 6.8890 6.8890 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.3333 0.3333 0.3333 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.6667 0.6667-0.0000 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.3333 0.3333 1.0000 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.0000 0.6667 0.6667 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.3333 1.0000 0.3333 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.6667-0.6667 0.6667 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-1.0000-0.3333 0.3333 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-1.3333 0.0000 0.0000 ( 387 PWs) bands (ev): - -3.0527 4.5130 6.9263 6.9263 + -3.1193 4.4527 6.8890 6.8890 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.3333-0.3333 1.0000 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.6667-0.0000 0.6667 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-1.0000 0.3333 0.3333 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k = 0.0000 0.0000 1.3333 ( 387 PWs) bands (ev): - -3.0527 4.5130 6.9263 6.9263 + -3.1193 4.4527 6.8890 6.8890 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.3333 0.3333 1.0000 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 occupation numbers 1.0000 1.0000 1.0000 1.0000 k =-0.6667 0.6667 0.6667 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 occupation numbers 1.0000 1.0000 1.0000 1.0000 - highest occupied level (ev): 9.5362 + highest occupied level (ev): 9.5160 Writing output data file sic.save/ - init_run : 0.11s CPU 0.11s WALL ( 1 calls) - electrons : 0.43s CPU 0.44s WALL ( 1 calls) + init_run : 0.21s CPU 0.22s WALL ( 1 calls) + electrons : 0.42s CPU 0.44s WALL ( 1 calls) Called by init_run: wfcinit : 0.00s CPU 0.00s WALL ( 1 calls) wfcinit:atom : 0.00s CPU 0.00s WALL ( 27 calls) wfcinit:wfcr : 0.05s CPU 0.05s WALL ( 27 calls) potinit : 0.01s CPU 0.01s WALL ( 1 calls) - hinit0 : 0.10s CPU 0.10s WALL ( 1 calls) + hinit0 : 0.20s CPU 0.20s WALL ( 1 calls) Called by electrons: - c_bands : 0.43s CPU 0.44s WALL ( 1 calls) + c_bands : 0.42s CPU 0.44s WALL ( 1 calls) v_of_rho : 0.01s CPU 0.01s WALL ( 1 calls) v_h : 0.00s CPU 0.00s WALL ( 1 calls) v_xc : 0.01s CPU 0.01s WALL ( 1 calls) @@ -795,37 +801,37 @@ T_2 3.00 0.00 -1.00 -1.00 1.00 Called by c_bands: init_us_2 : 0.00s CPU 0.00s WALL ( 27 calls) - cegterg : 0.37s CPU 0.38s WALL ( 27 calls) + cegterg : 0.36s CPU 0.38s WALL ( 27 calls) Called by sum_band: Called by *egterg: - h_psi : 0.37s CPU 0.38s WALL ( 414 calls) - s_psi : 0.01s CPU 0.01s WALL ( 414 calls) - g_psi : 0.00s CPU 0.00s WALL ( 360 calls) - cdiaghg : 0.01s CPU 0.01s WALL ( 387 calls) - cegterg:over : 0.01s CPU 0.01s WALL ( 360 calls) - cegterg:upda : 0.01s CPU 0.01s WALL ( 360 calls) - cegterg:last : 0.00s CPU 0.00s WALL ( 120 calls) + h_psi : 0.36s CPU 0.38s WALL ( 443 calls) + s_psi : 0.01s CPU 0.01s WALL ( 443 calls) + g_psi : 0.00s CPU 0.00s WALL ( 389 calls) + cdiaghg : 0.01s CPU 0.01s WALL ( 416 calls) + cegterg:over : 0.01s CPU 0.01s WALL ( 389 calls) + cegterg:upda : 0.01s CPU 0.01s WALL ( 389 calls) + cegterg:last : 0.00s CPU 0.01s WALL ( 133 calls) Called by h_psi: - h_psi:pot : 0.37s CPU 0.38s WALL ( 414 calls) - h_psi:calbec : 0.01s CPU 0.01s WALL ( 414 calls) - vloc_psi : 0.35s CPU 0.36s WALL ( 414 calls) - add_vuspsi : 0.01s CPU 0.01s WALL ( 414 calls) + h_psi:pot : 0.36s CPU 0.38s WALL ( 443 calls) + h_psi:calbec : 0.01s CPU 0.01s WALL ( 443 calls) + vloc_psi : 0.35s CPU 0.36s WALL ( 443 calls) + add_vuspsi : 0.01s CPU 0.01s WALL ( 443 calls) General routines - calbec : 0.01s CPU 0.01s WALL ( 414 calls) - fft : 0.00s CPU 0.00s WALL ( 11 calls) - fftw : 0.32s CPU 0.33s WALL ( 3206 calls) + calbec : 0.01s CPU 0.01s WALL ( 443 calls) + fft : 0.00s CPU 0.00s WALL ( 12 calls) + fftw : 0.32s CPU 0.33s WALL ( 3438 calls) davcio : 0.00s CPU 0.00s WALL ( 54 calls) Parallel routines - PWSCF : 0.69s CPU 0.71s WALL + PWSCF : 0.98s CPU 1.01s WALL - This run was terminated on: 19: 6:15 18Jan2019 + This run was terminated on: 11:28:24 18Jul2019 =------------------------------------------------------------------------------= JOB DONE. diff --git a/test-suite/epw_trev_uspp/benchmark.out.git.inp=ph.in.args=2 b/test-suite/epw_trev_uspp/benchmark.out.git.inp=ph.in.args=2 index a1a01b17f6..97b9a1bfbe 100644 --- a/test-suite/epw_trev_uspp/benchmark.out.git.inp=ph.in.args=2 +++ b/test-suite/epw_trev_uspp/benchmark.out.git.inp=ph.in.args=2 @@ -1,5 +1,5 @@ - Program PHONON v.6.3 starts on 18Jan2019 at 19: 5:22 + Program PHONON v.6.4.1 starts on 18Jul2019 at 11:27:29 This program is part of the open-source Quantum ESPRESSO suite for quantum simulation of materials; please cite @@ -17,7 +17,8 @@ ./sic.save/ IMPORTANT: XC functional enforced from input : - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) Any further DFT definition will be discarded Please, verify this is what you really want @@ -29,6 +30,8 @@ Sum 283 283 91 3119 3119 609 + Check: negative core charge= -0.000002 + Dynamical matrices for ( 3, 3, 3) uniform grid of q-points ( 4 q-points): @@ -40,6 +43,153 @@ Calculation of q = 0.0000000 0.0000000 0.0000000 + Subspace diagonalization in iterative solution of the eigenvalue problem: + a serial algorithm will be used + + + G-vector sticks info + -------------------- + sticks: dense smooth PW G-vecs: dense smooth PW + Sum 283 283 91 3119 3119 609 + + + Title: + -- + + + bravais-lattice index = 2 + lattice parameter (alat) = 8.2370 a.u. + unit-cell volume = 139.7163 (a.u.)^3 + number of atoms/cell = 2 + number of atomic types = 2 + number of electrons = 8.00 + number of Kohn-Sham states= 4 + kinetic-energy cutoff = 30.0000 Ry + charge density cutoff = 120.0000 Ry + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) + + celldm(1)= 8.237000 celldm(2)= 0.000000 celldm(3)= 0.000000 + celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000 + + crystal axes: (cart. coord. in units of alat) + a(1) = ( -0.500000 0.000000 0.500000 ) + a(2) = ( 0.000000 0.500000 0.500000 ) + a(3) = ( -0.500000 0.500000 0.000000 ) + + reciprocal axes: (cart. coord. in units 2 pi/alat) + b(1) = ( -1.000000 -1.000000 1.000000 ) + b(2) = ( 1.000000 1.000000 1.000000 ) + b(3) = ( -1.000000 1.000000 -1.000000 ) + + + PseudoPot. # 1 for Si read from file: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: + l(1) = 0 + l(2) = 0 + l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + + + PseudoPot. # 2 for C read from file: + ../../pseudo/C.pbe-rrkjus.UPF + MD5 check sum: c9ac5a99bc85b198593446162950cd17 + Pseudo is Ultrasoft, Zval = 4.0 + Generated by new atomic code, or converted to UPF format + Using radial grid of 627 points, 4 beta functions with: + l(1) = 0 + l(2) = 0 + l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + + + atomic species valence mass pseudopotential + Si 4.00 28.08550 Si( 1.00) + C 4.00 12.01078 C ( 1.00) + + 24 Sym. Ops. (no inversion) found + + + + Cartesian axes + + site n. atom positions (alat units) + 1 Si tau( 1) = ( 0.0000000 0.0000000 0.0000000 ) + 2 C tau( 2) = ( 0.2500000 0.2500000 0.2500000 ) + + number of k points= 8 + cart. coord. in units 2pi/alat + k( 1) = ( 0.0000000 0.0000000 0.0000000), wk = 0.0312500 + k( 2) = ( -0.2500000 0.2500000 -0.2500000), wk = 0.2500000 + k( 3) = ( 0.5000000 -0.5000000 0.5000000), wk = 0.1250000 + k( 4) = ( 0.0000000 0.5000000 0.0000000), wk = 0.1875000 + k( 5) = ( 0.7500000 -0.2500000 0.7500000), wk = 0.7500000 + k( 6) = ( 0.5000000 0.0000000 0.5000000), wk = 0.3750000 + k( 7) = ( 0.0000000 -1.0000000 0.0000000), wk = 0.0937500 + k( 8) = ( -0.5000000 -1.0000000 0.0000000), wk = 0.1875000 + + Dense grid: 3119 G-vectors FFT dimensions: ( 24, 24, 24) + + Estimated max dynamical RAM per process > 4.30 MB + + Check: negative core charge= -0.000002 + + The potential is recalculated from file : + ./_ph0/sic.save/charge-density + + Starting wfcs are 8 atomic wfcs + + Band Structure Calculation + Davidson diagonalization with overlap + + ethr = 1.25E-10, avg # of iterations = 11.1 + + total cpu time spent up to now is 0.3 secs + + End of band structure calculation + + k = 0.0000 0.0000 0.0000 ( 387 PWs) bands (ev): + + -5.8991 9.5160 9.5160 9.5160 + + k =-0.2500 0.2500-0.2500 ( 380 PWs) bands (ev): + + -4.7019 5.2106 8.9035 8.9035 + + k = 0.5000-0.5000 0.5000 ( 392 PWs) bands (ev): + + -2.3179 0.9478 8.4533 8.4533 + + k = 0.0000 0.5000 0.0000 ( 375 PWs) bands (ev): + + -4.2994 6.1699 7.5679 7.5679 + + k = 0.7500-0.2500 0.7500 ( 390 PWs) bands (ev): + + -1.9365 2.4313 5.5403 7.1904 + + k = 0.5000 0.0000 0.5000 ( 399 PWs) bands (ev): + + -2.8677 3.5594 5.1536 8.3214 + + k = 0.0000-1.0000 0.0000 ( 388 PWs) bands (ev): + + -0.8573 1.6897 6.3076 6.3076 + + k =-0.5000-1.0000 0.0000 ( 396 PWs) bands (ev): + + -0.6219 2.4618 4.5064 4.7964 + + highest occupied level (ev): 9.5160 + + Writing output data file sic.save/ + -- bravais-lattice index = 2 @@ -52,7 +202,8 @@ convergence threshold = 1.0E-14 beta = 0.7000 number of iterations used = 4 - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.23700 celldm(2)= 0.00000 celldm(3)= 0.00000 @@ -87,14 +238,17 @@ number of k points= 8 PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -127,67 +281,67 @@ Alpha used in Ewald sum = 1.3000 - PHONON : 0.38s CPU 0.38s WALL + PHONON : 1.11s CPU 1.14s WALL Electric Fields Calculation - iter # 1 total cpu time : 1.0 secs av.it.: 5.8 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.267E-07 + iter # 1 total cpu time : 1.8 secs av.it.: 5.8 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.207E-07 - iter # 2 total cpu time : 1.3 secs av.it.: 9.3 - thresh= 3.559E-05 alpha_mix = 0.700 |ddv_scf|^2 = 4.305E-09 + iter # 2 total cpu time : 2.1 secs av.it.: 9.4 + thresh= 3.474E-05 alpha_mix = 0.700 |ddv_scf|^2 = 3.786E-09 - iter # 3 total cpu time : 1.6 secs av.it.: 9.1 - thresh= 6.561E-06 alpha_mix = 0.700 |ddv_scf|^2 = 4.253E-10 + iter # 3 total cpu time : 2.3 secs av.it.: 9.2 + thresh= 6.153E-06 alpha_mix = 0.700 |ddv_scf|^2 = 3.667E-10 - iter # 4 total cpu time : 1.8 secs av.it.: 9.0 - thresh= 2.062E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.373E-12 + iter # 4 total cpu time : 2.6 secs av.it.: 9.3 + thresh= 1.915E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.794E-12 - iter # 5 total cpu time : 2.1 secs av.it.: 9.3 - thresh= 1.540E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.903E-14 + iter # 5 total cpu time : 2.9 secs av.it.: 9.5 + thresh= 1.672E-07 alpha_mix = 0.700 |ddv_scf|^2 = 2.258E-14 - iter # 6 total cpu time : 2.4 secs av.it.: 9.5 - thresh= 1.379E-08 alpha_mix = 0.700 |ddv_scf|^2 = 4.241E-16 + iter # 6 total cpu time : 3.2 secs av.it.: 9.5 + thresh= 1.503E-08 alpha_mix = 0.700 |ddv_scf|^2 = 3.904E-16 End of electric fields calculation Dielectric constant in cartesian axis - ( 9.239423963 -0.000000000 0.000000000 ) - ( -0.000000000 9.239423963 0.000000000 ) - ( -0.000000000 0.000000000 9.239423963 ) + ( 9.334937516 0.000000000 0.000000000 ) + ( 0.000000000 9.334937516 -0.000000000 ) + ( 0.000000000 -0.000000000 9.334937516 ) Effective charges (d Force / dE) in cartesian axis atom 1 Si - Ex ( 2.44208 -0.00000 0.00000 ) - Ey ( -0.00000 2.44208 0.00000 ) - Ez ( 0.00000 0.00000 2.44208 ) + Ex ( 2.44272 0.00000 -0.00000 ) + Ey ( -0.00000 2.44272 -0.00000 ) + Ez ( -0.00000 -0.00000 2.44272 ) atom 2 C - Ex ( -3.43019 0.00000 0.00000 ) - Ey ( 0.00000 -3.43019 0.00000 ) - Ez ( 0.00000 0.00000 -3.43019 ) + Ex ( -3.44802 -0.00000 -0.00000 ) + Ey ( -0.00000 -3.44802 0.00000 ) + Ez ( -0.00000 0.00000 -3.44802 ) Representation # 1 modes # 1 2 3 Self-consistent Calculation - iter # 1 total cpu time : 2.8 secs av.it.: 5.9 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 7.987E-07 + iter # 1 total cpu time : 3.7 secs av.it.: 6.0 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 8.017E-07 - iter # 2 total cpu time : 3.1 secs av.it.: 9.7 - thresh= 8.937E-05 alpha_mix = 0.700 |ddv_scf|^2 = 9.243E-09 + iter # 2 total cpu time : 4.0 secs av.it.: 10.0 + thresh= 8.954E-05 alpha_mix = 0.700 |ddv_scf|^2 = 9.491E-09 - iter # 3 total cpu time : 3.4 secs av.it.: 9.5 - thresh= 9.614E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.432E-10 + iter # 3 total cpu time : 4.3 secs av.it.: 9.7 + thresh= 9.742E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.439E-10 - iter # 4 total cpu time : 3.7 secs av.it.: 8.4 - thresh= 1.559E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.698E-13 + iter # 4 total cpu time : 4.6 secs av.it.: 8.7 + thresh= 1.562E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.004E-13 - iter # 5 total cpu time : 4.0 secs av.it.: 9.1 - thresh= 4.121E-08 alpha_mix = 0.700 |ddv_scf|^2 = 7.006E-15 + iter # 5 total cpu time : 4.9 secs av.it.: 9.2 + thresh= 4.477E-08 alpha_mix = 0.700 |ddv_scf|^2 = 7.508E-15 End of self-consistent calculation @@ -198,20 +352,20 @@ Self-consistent Calculation - iter # 1 total cpu time : 4.2 secs av.it.: 5.2 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 4.054E-08 + iter # 1 total cpu time : 5.1 secs av.it.: 5.0 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 8.636E-08 - iter # 2 total cpu time : 4.5 secs av.it.: 9.3 - thresh= 2.014E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.485E-09 + iter # 2 total cpu time : 5.4 secs av.it.: 9.1 + thresh= 2.939E-05 alpha_mix = 0.700 |ddv_scf|^2 = 7.066E-09 - iter # 3 total cpu time : 4.8 secs av.it.: 8.8 - thresh= 3.853E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.263E-10 + iter # 3 total cpu time : 5.7 secs av.it.: 8.9 + thresh= 8.406E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.919E-11 - iter # 4 total cpu time : 5.1 secs av.it.: 8.8 - thresh= 1.124E-06 alpha_mix = 0.700 |ddv_scf|^2 = 5.580E-13 + iter # 4 total cpu time : 6.0 secs av.it.: 9.4 + thresh= 5.403E-07 alpha_mix = 0.700 |ddv_scf|^2 = 8.809E-13 - iter # 5 total cpu time : 5.4 secs av.it.: 9.2 - thresh= 7.470E-08 alpha_mix = 0.700 |ddv_scf|^2 = 5.755E-15 + iter # 5 total cpu time : 6.3 secs av.it.: 9.6 + thresh= 9.386E-08 alpha_mix = 0.700 |ddv_scf|^2 = 6.414E-15 End of self-consistent calculation @@ -223,56 +377,52 @@ Dielectric constant in cartesian axis - ( 9.239423963 -0.000000000 0.000000000 ) - ( -0.000000000 9.239423963 0.000000000 ) - ( -0.000000000 0.000000000 9.239423963 ) + ( 9.334937516 0.000000000 0.000000000 ) + ( 0.000000000 9.334937516 -0.000000000 ) + ( 0.000000000 -0.000000000 9.334937516 ) Effective charges (d Force / dE) in cartesian axis atom 1 Si - Ex ( 2.44208 -0.00000 0.00000 ) - Ey ( -0.00000 2.44208 0.00000 ) - Ez ( 0.00000 0.00000 2.44208 ) + Ex ( 2.44272 0.00000 -0.00000 ) + Ey ( -0.00000 2.44272 -0.00000 ) + Ez ( -0.00000 -0.00000 2.44272 ) atom 2 C - Ex ( -3.43019 0.00000 0.00000 ) - Ey ( 0.00000 -3.43019 0.00000 ) - Ez ( 0.00000 0.00000 -3.43019 ) + Ex ( -3.44802 -0.00000 -0.00000 ) + Ey ( -0.00000 -3.44802 0.00000 ) + Ez ( -0.00000 0.00000 -3.44802 ) Effective charges (d P / du) in cartesian axis atom 1 Si - Px ( 2.44220 -0.00000 0.00000 ) - Py ( -0.00000 2.44220 0.00000 ) - Pz ( 0.00000 0.00000 2.44220 ) + Px ( 2.44282 0.00000 0.00000 ) + Py ( 0.00000 2.44282 0.00000 ) + Pz ( 0.00000 0.00000 2.44282 ) atom 2 C - Px ( -3.43005 -0.00000 0.00000 ) - Py ( -0.00000 -3.43005 0.00000 ) - Pz ( 0.00000 -0.00000 -3.43005 ) + Px ( -3.44786 0.00000 0.00000 ) + Py ( 0.00000 -3.44786 -0.00000 ) + Pz ( 0.00000 0.00000 -3.44786 ) Diagonalizing the dynamical matrix q = ( 0.000000000 0.000000000 0.000000000 ) ************************************************************************** - freq ( 1) = 2.949092 [THz] = 98.371116 [cm-1] - freq ( 2) = 2.949092 [THz] = 98.371116 [cm-1] - freq ( 3) = 2.949092 [THz] = 98.371116 [cm-1] - freq ( 4) = 23.893935 [THz] = 797.015896 [cm-1] - freq ( 5) = 23.893935 [THz] = 797.015896 [cm-1] - freq ( 6) = 23.893935 [THz] = 797.015896 [cm-1] + freq ( 1) = 2.954350 [THz] = 98.546510 [cm-1] + freq ( 2) = 2.954350 [THz] = 98.546510 [cm-1] + freq ( 3) = 2.954350 [THz] = 98.546510 [cm-1] + freq ( 4) = 24.071582 [THz] = 802.941560 [cm-1] + freq ( 5) = 24.071582 [THz] = 802.941560 [cm-1] + freq ( 6) = 24.071582 [THz] = 802.941560 [cm-1] ************************************************************************** Mode symmetry, T_d (-43m) point group: - freq ( 1 - 3) = 98.4 [cm-1] --> T_2 G_15 P_4 I+R - freq ( 4 - 6) = 797.0 [cm-1] --> T_2 G_15 P_4 I+R + freq ( 1 - 3) = 98.5 [cm-1] --> T_2 G_15 P_4 I+R + freq ( 4 - 6) = 802.9 [cm-1] --> T_2 G_15 P_4 I+R Calculation of q = -0.3333333 0.3333333 -0.3333333 - Subspace diagonalization in iterative solution of the eigenvalue problem: - a serial algorithm will be used - - G-vector sticks info -------------------- sticks: dense smooth PW G-vecs: dense smooth PW @@ -292,7 +442,8 @@ number of Kohn-Sham states= 4 kinetic-energy cutoff = 30.0000 Ry charge density cutoff = 120.0000 Ry - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.237000 celldm(2)= 0.000000 celldm(3)= 0.000000 celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000 @@ -309,14 +460,17 @@ PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -390,7 +544,9 @@ Dense grid: 3119 G-vectors FFT dimensions: ( 24, 24, 24) - Estimated max dynamical RAM per process > 4.31 MB + Estimated max dynamical RAM per process > 4.33 MB + + Check: negative core charge= -0.000002 The potential is recalculated from file : ./_ph0/sic.q_2/sic.save/charge-density @@ -400,173 +556,173 @@ Band Structure Calculation Davidson diagonalization with overlap - ethr = 1.25E-10, avg # of iterations = 11.2 + ethr = 1.25E-10, avg # of iterations = 11.5 - total cpu time spent up to now is 0.6 secs + total cpu time spent up to now is 1.1 secs End of band structure calculation k = 0.0000 0.0000 0.0000 ( 387 PWs) bands (ev): - -5.8255 9.5362 9.5362 9.5362 + -5.8991 9.5160 9.5160 9.5160 k =-0.3333 0.3333-0.3333 ( 389 PWs) bands (ev): - -3.7598 3.3767 8.6927 8.6927 + -3.8294 3.3222 8.6634 8.6634 k =-0.2500 0.2500-0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k =-0.5833 0.5833-0.5833 ( 386 PWs) bands (ev): - -2.7994 1.7761 8.5378 8.5378 + -2.8664 1.7157 8.5072 8.5072 k = 0.5000-0.5000 0.5000 ( 392 PWs) bands (ev): - -2.2529 1.0113 8.4844 8.4844 + -2.3179 0.9478 8.4533 8.4533 k = 0.1667-0.1667 0.1667 ( 380 PWs) bands (ev): - -5.2866 7.1753 9.2062 9.2062 + -5.3593 7.1380 9.1819 9.1819 k = 0.0000 0.5000 0.0000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k =-0.3333 0.8333-0.3333 ( 388 PWs) bands (ev): - -1.4150 1.9298 5.0499 7.4731 + -1.4733 1.8594 4.9996 7.4373 k = 0.7500-0.2500 0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.4167 0.0833 0.4167 ( 391 PWs) bands (ev): - -3.6211 4.1960 6.4908 8.8001 + -3.6902 4.1438 6.4461 8.7708 k = 0.5000 0.0000 0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 0.1667 0.3333 0.1667 ( 382 PWs) bands (ev): - -4.7578 5.9282 8.5402 8.8662 + -4.8295 5.8839 8.5114 8.8371 k = 0.0000-1.0000 0.0000 ( 388 PWs) bands (ev): - -0.8103 1.7773 6.3474 6.3474 + -0.8573 1.6897 6.3076 6.3076 k =-0.3333-0.6667-0.3333 ( 385 PWs) bands (ev): - -2.1136 1.7813 6.7723 7.7842 + -2.1771 1.7176 6.7274 7.7499 k =-0.5000-1.0000 0.0000 ( 396 PWs) bands (ev): - -0.5749 2.5599 4.5456 4.8386 + -0.6219 2.4618 4.5064 4.7964 k =-0.8333-0.6667-0.3333 ( 390 PWs) bands (ev): - -2.3691 2.8145 6.1169 7.3285 + -2.4336 2.7528 6.0692 7.2918 k = 0.2500 0.2500 0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k =-0.0833 0.5833-0.0833 ( 390 PWs) bands (ev): - -3.5942 5.1032 7.1037 7.2937 + -3.6628 5.0495 7.0647 7.2580 k = 0.2500-0.2500 0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k =-0.0833 0.0833-0.0833 ( 375 PWs) bands (ev): - -5.6898 8.8134 9.4412 9.4412 + -5.7631 8.7868 9.4200 9.4200 k =-0.2500 0.2500 0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k =-0.5833 0.5833-0.0833 ( 393 PWs) bands (ev): - -1.9163 2.5854 4.8261 7.8709 + -1.9785 2.5204 4.7752 7.8365 k =-0.5000-0.5000-0.5000 ( 392 PWs) bands (ev): - -2.2529 1.0113 8.4844 8.4844 + -2.3179 0.9478 8.4533 8.4533 k =-0.8333-0.1667-0.8333 ( 392 PWs) bands (ev): - -1.4973 2.7232 5.1922 6.7572 + -1.5552 2.6478 5.1478 6.7189 k = 0.5000 0.0000 0.0000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k = 0.1667 0.3333-0.3333 ( 379 PWs) bands (ev): - -4.2457 4.6700 7.9860 9.0357 + -4.3163 4.6206 7.9517 9.0090 k =-0.2500-0.7500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.5833-0.4167-1.0833 ( 389 PWs) bands (ev): - -2.6905 3.2940 5.6272 7.9715 + -2.7565 3.2354 5.5784 7.9370 k =-0.7500-0.2500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-1.0833 0.0833-1.0833 ( 391 PWs) bands (ev): - -1.0522 2.1426 5.8663 6.4523 + -1.1041 2.0599 5.8248 6.4129 k =-0.7500 0.2500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-1.0833 0.5833-1.0833 ( 382 PWs) bands (ev): - -4.6225 6.4642 8.0463 8.1689 + -4.6939 6.4211 8.0148 8.1355 k = 0.7500-0.2500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.4167 0.0833-1.0833 ( 390 PWs) bands (ev): - -0.7849 2.4925 4.4023 5.6013 + -0.8354 2.4034 4.3585 5.5602 k = 0.7500 0.2500 0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.4167 0.5833 0.4167 ( 389 PWs) bands (ev): - -2.2247 1.2181 7.9489 8.2773 + -2.2893 1.1546 7.9122 8.2453 k = 0.0000-0.5000-0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k =-0.3333-0.1667-0.8333 ( 391 PWs) bands (ev): - -1.2929 2.4070 4.8186 6.6455 + -1.3496 2.3319 4.7701 6.6064 k =-0.5000 0.0000-0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k =-0.8333 0.3333-0.8333 ( 390 PWs) bands (ev): - -2.7630 3.7507 6.3358 7.1644 + -2.8288 3.6907 6.2905 7.1280 - highest occupied level (ev): 9.5362 + highest occupied level (ev): 9.5160 Writing output data file sic.save/ @@ -582,7 +738,8 @@ convergence threshold = 1.0E-14 beta = 0.7000 number of iterations used = 4 - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.23700 celldm(2)= 0.00000 celldm(3)= 0.00000 @@ -617,14 +774,17 @@ number of k points= 40 PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -656,7 +816,7 @@ Alpha used in Ewald sum = 1.3000 - PHONON : 6.06s CPU 6.27s WALL + PHONON : 7.24s CPU 7.47s WALL @@ -664,35 +824,38 @@ Self-consistent Calculation - iter # 1 total cpu time : 6.5 secs av.it.: 6.0 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 3.935E-04 + iter # 1 total cpu time : 7.7 secs av.it.: 6.0 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 3.900E-04 - iter # 2 total cpu time : 6.7 secs av.it.: 7.8 - thresh= 1.984E-03 alpha_mix = 0.700 |ddv_scf|^2 = 1.389E-03 + iter # 2 total cpu time : 7.9 secs av.it.: 7.9 + thresh= 1.975E-03 alpha_mix = 0.700 |ddv_scf|^2 = 1.401E-03 - iter # 3 total cpu time : 6.9 secs av.it.: 7.0 - thresh= 3.727E-03 alpha_mix = 0.700 |ddv_scf|^2 = 3.165E-07 + iter # 3 total cpu time : 8.1 secs av.it.: 7.0 + thresh= 3.743E-03 alpha_mix = 0.700 |ddv_scf|^2 = 3.063E-07 - iter # 4 total cpu time : 7.1 secs av.it.: 8.2 - thresh= 5.626E-05 alpha_mix = 0.700 |ddv_scf|^2 = 3.143E-08 + iter # 4 total cpu time : 8.3 secs av.it.: 8.6 + thresh= 5.534E-05 alpha_mix = 0.700 |ddv_scf|^2 = 4.868E-08 - iter # 5 total cpu time : 7.3 secs av.it.: 8.2 - thresh= 1.773E-05 alpha_mix = 0.700 |ddv_scf|^2 = 4.934E-10 + iter # 5 total cpu time : 8.5 secs av.it.: 8.4 + thresh= 2.206E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.608E-09 - iter # 6 total cpu time : 7.6 secs av.it.: 8.1 - thresh= 2.221E-06 alpha_mix = 0.700 |ddv_scf|^2 = 8.363E-12 + iter # 6 total cpu time : 8.8 secs av.it.: 8.4 + thresh= 4.010E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.270E-11 - iter # 7 total cpu time : 7.8 secs av.it.: 8.0 - thresh= 2.892E-07 alpha_mix = 0.700 |ddv_scf|^2 = 3.436E-13 + iter # 7 total cpu time : 9.0 secs av.it.: 8.2 + thresh= 3.564E-07 alpha_mix = 0.700 |ddv_scf|^2 = 8.636E-12 - iter # 8 total cpu time : 8.0 secs av.it.: 8.1 - thresh= 5.862E-08 alpha_mix = 0.700 |ddv_scf|^2 = 4.821E-13 + iter # 8 total cpu time : 9.2 secs av.it.: 7.4 + thresh= 2.939E-07 alpha_mix = 0.700 |ddv_scf|^2 = 6.442E-13 - iter # 9 total cpu time : 8.2 secs av.it.: 7.2 - thresh= 6.944E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.669E-14 + iter # 9 total cpu time : 9.4 secs av.it.: 7.9 + thresh= 8.026E-08 alpha_mix = 0.700 |ddv_scf|^2 = 7.992E-14 - iter # 10 total cpu time : 8.4 secs av.it.: 7.8 - thresh= 1.292E-08 alpha_mix = 0.700 |ddv_scf|^2 = 2.350E-15 + iter # 10 total cpu time : 9.6 secs av.it.: 8.2 + thresh= 2.827E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.151E-14 + + iter # 11 total cpu time : 9.9 secs av.it.: 8.4 + thresh= 1.073E-08 alpha_mix = 0.700 |ddv_scf|^2 = 4.504E-16 End of self-consistent calculation @@ -703,35 +866,32 @@ Self-consistent Calculation - iter # 1 total cpu time : 8.6 secs av.it.: 6.2 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 8.690E-04 - - iter # 2 total cpu time : 8.9 secs av.it.: 7.7 - thresh= 2.948E-03 alpha_mix = 0.700 |ddv_scf|^2 = 3.102E-03 + iter # 1 total cpu time : 10.1 secs av.it.: 6.4 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 8.719E-04 - iter # 3 total cpu time : 9.0 secs av.it.: 6.8 - thresh= 5.569E-03 alpha_mix = 0.700 |ddv_scf|^2 = 1.874E-06 + iter # 2 total cpu time : 10.3 secs av.it.: 7.8 + thresh= 2.953E-03 alpha_mix = 0.700 |ddv_scf|^2 = 3.142E-03 - iter # 4 total cpu time : 9.3 secs av.it.: 8.3 - thresh= 1.369E-04 alpha_mix = 0.700 |ddv_scf|^2 = 1.590E-07 + iter # 3 total cpu time : 10.5 secs av.it.: 6.8 + thresh= 5.606E-03 alpha_mix = 0.700 |ddv_scf|^2 = 1.934E-06 - iter # 5 total cpu time : 9.5 secs av.it.: 7.7 - thresh= 3.988E-05 alpha_mix = 0.700 |ddv_scf|^2 = 2.242E-09 + iter # 4 total cpu time : 10.7 secs av.it.: 8.6 + thresh= 1.391E-04 alpha_mix = 0.700 |ddv_scf|^2 = 1.641E-07 - iter # 6 total cpu time : 9.7 secs av.it.: 7.7 - thresh= 4.735E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.751E-11 + iter # 5 total cpu time : 10.9 secs av.it.: 7.8 + thresh= 4.051E-05 alpha_mix = 0.700 |ddv_scf|^2 = 2.242E-09 - iter # 7 total cpu time : 9.9 secs av.it.: 8.1 - thresh= 4.184E-07 alpha_mix = 0.700 |ddv_scf|^2 = 8.403E-13 + iter # 6 total cpu time : 11.2 secs av.it.: 7.8 + thresh= 4.735E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.206E-10 - iter # 8 total cpu time : 10.2 secs av.it.: 8.3 - thresh= 9.167E-08 alpha_mix = 0.700 |ddv_scf|^2 = 3.417E-13 + iter # 7 total cpu time : 11.4 secs av.it.: 8.1 + thresh= 1.098E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.990E-10 - iter # 9 total cpu time : 10.4 secs av.it.: 7.2 - thresh= 5.846E-08 alpha_mix = 0.700 |ddv_scf|^2 = 3.996E-14 + iter # 8 total cpu time : 11.6 secs av.it.: 7.2 + thresh= 1.411E-06 alpha_mix = 0.700 |ddv_scf|^2 = 3.189E-13 - iter # 10 total cpu time : 10.6 secs av.it.: 8.0 - thresh= 1.999E-08 alpha_mix = 0.700 |ddv_scf|^2 = 3.457E-15 + iter # 9 total cpu time : 11.8 secs av.it.: 7.8 + thresh= 5.647E-08 alpha_mix = 0.700 |ddv_scf|^2 = 8.869E-15 End of self-consistent calculation @@ -742,23 +902,23 @@ Self-consistent Calculation - iter # 1 total cpu time : 10.9 secs av.it.: 6.0 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.210E-06 + iter # 1 total cpu time : 12.2 secs av.it.: 6.0 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.215E-06 - iter # 2 total cpu time : 11.4 secs av.it.: 9.2 - thresh= 1.487E-04 alpha_mix = 0.700 |ddv_scf|^2 = 4.193E-08 + iter # 2 total cpu time : 12.7 secs av.it.: 9.4 + thresh= 1.488E-04 alpha_mix = 0.700 |ddv_scf|^2 = 4.247E-08 - iter # 3 total cpu time : 11.9 secs av.it.: 9.2 - thresh= 2.048E-05 alpha_mix = 0.700 |ddv_scf|^2 = 6.106E-10 + iter # 3 total cpu time : 13.2 secs av.it.: 9.3 + thresh= 2.061E-05 alpha_mix = 0.700 |ddv_scf|^2 = 6.096E-10 - iter # 4 total cpu time : 12.3 secs av.it.: 8.1 - thresh= 2.471E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.220E-12 + iter # 4 total cpu time : 13.6 secs av.it.: 8.1 + thresh= 2.469E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.361E-12 - iter # 5 total cpu time : 12.8 secs av.it.: 8.8 - thresh= 1.104E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.809E-14 + iter # 5 total cpu time : 14.1 secs av.it.: 9.0 + thresh= 1.166E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.797E-14 - iter # 6 total cpu time : 13.3 secs av.it.: 8.9 - thresh= 1.345E-08 alpha_mix = 0.700 |ddv_scf|^2 = 3.334E-16 + iter # 6 total cpu time : 14.6 secs av.it.: 9.1 + thresh= 1.341E-08 alpha_mix = 0.700 |ddv_scf|^2 = 3.352E-16 End of self-consistent calculation @@ -769,23 +929,23 @@ Self-consistent Calculation - iter # 1 total cpu time : 13.6 secs av.it.: 5.2 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.598E-07 + iter # 1 total cpu time : 14.9 secs av.it.: 5.1 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.331E-07 - iter # 2 total cpu time : 14.1 secs av.it.: 9.1 - thresh= 3.998E-05 alpha_mix = 0.700 |ddv_scf|^2 = 4.695E-09 + iter # 2 total cpu time : 15.4 secs av.it.: 8.9 + thresh= 4.828E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.700E-08 - iter # 3 total cpu time : 14.6 secs av.it.: 8.8 - thresh= 6.852E-06 alpha_mix = 0.700 |ddv_scf|^2 = 4.809E-10 + iter # 3 total cpu time : 15.8 secs av.it.: 8.7 + thresh= 1.304E-05 alpha_mix = 0.700 |ddv_scf|^2 = 4.733E-10 - iter # 4 total cpu time : 15.0 secs av.it.: 8.3 - thresh= 2.193E-06 alpha_mix = 0.700 |ddv_scf|^2 = 4.402E-12 + iter # 4 total cpu time : 16.3 secs av.it.: 8.9 + thresh= 2.176E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.563E-12 - iter # 5 total cpu time : 15.5 secs av.it.: 8.5 - thresh= 2.098E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.370E-14 + iter # 5 total cpu time : 16.8 secs av.it.: 9.3 + thresh= 1.601E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.910E-14 - iter # 6 total cpu time : 15.9 secs av.it.: 8.8 - thresh= 1.171E-08 alpha_mix = 0.700 |ddv_scf|^2 = 7.461E-17 + iter # 6 total cpu time : 17.3 secs av.it.: 9.1 + thresh= 1.382E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.442E-16 End of self-consistent calculation @@ -808,20 +968,20 @@ q = ( -0.333333333 0.333333333 -0.333333333 ) ************************************************************************** - freq ( 1) = 7.545860 [THz] = 251.702796 [cm-1] - freq ( 2) = 7.545860 [THz] = 251.702796 [cm-1] - freq ( 3) = 15.283233 [THz] = 509.793791 [cm-1] - freq ( 4) = 23.268805 [THz] = 776.163789 [cm-1] - freq ( 5) = 23.268805 [THz] = 776.163789 [cm-1] - freq ( 6) = 26.887617 [THz] = 896.874361 [cm-1] + freq ( 1) = 7.556269 [THz] = 252.050002 [cm-1] + freq ( 2) = 7.556269 [THz] = 252.050002 [cm-1] + freq ( 3) = 15.271769 [THz] = 509.411365 [cm-1] + freq ( 4) = 23.440432 [THz] = 781.888659 [cm-1] + freq ( 5) = 23.440432 [THz] = 781.888659 [cm-1] + freq ( 6) = 27.020438 [THz] = 901.304808 [cm-1] ************************************************************************** Mode symmetry, C_3v (3m) point group: - freq ( 1 - 2) = 251.7 [cm-1] --> E L_3 - freq ( 3 - 3) = 509.8 [cm-1] --> A_1 L_1 - freq ( 4 - 5) = 776.2 [cm-1] --> E L_3 - freq ( 6 - 6) = 896.9 [cm-1] --> A_1 L_1 + freq ( 1 - 2) = 252.1 [cm-1] --> E L_3 + freq ( 3 - 3) = 509.4 [cm-1] --> A_1 L_1 + freq ( 4 - 5) = 781.9 [cm-1] --> E L_3 + freq ( 6 - 6) = 901.3 [cm-1] --> A_1 L_1 Calculation of q = 0.0000000 0.6666667 0.0000000 @@ -844,7 +1004,8 @@ number of Kohn-Sham states= 4 kinetic-energy cutoff = 30.0000 Ry charge density cutoff = 120.0000 Ry - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.237000 celldm(2)= 0.000000 celldm(3)= 0.000000 celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000 @@ -861,14 +1022,17 @@ PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -954,7 +1118,9 @@ Dense grid: 3119 G-vectors FFT dimensions: ( 24, 24, 24) - Estimated max dynamical RAM per process > 4.31 MB + Estimated max dynamical RAM per process > 4.33 MB + + Check: negative core charge= -0.000002 The potential is recalculated from file : ./_ph0/sic.q_3/sic.save/charge-density @@ -964,221 +1130,221 @@ Band Structure Calculation Davidson diagonalization with overlap - ethr = 1.25E-10, avg # of iterations = 11.2 + ethr = 1.25E-10, avg # of iterations = 11.5 - total cpu time spent up to now is 1.5 secs + total cpu time spent up to now is 2.0 secs End of band structure calculation k = 0.0000 0.0000 0.0000 ( 387 PWs) bands (ev): - -5.8255 9.5362 9.5362 9.5362 + -5.8991 9.5160 9.5160 9.5160 k = 0.0000 0.6667 0.0000 ( 387 PWs) bands (ev): - -3.0527 4.5130 6.9263 6.9263 + -3.1193 4.4527 6.8890 6.8890 k =-0.2500 0.2500-0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k =-0.2500 0.9167-0.2500 ( 388 PWs) bands (ev): - -0.9566 2.2990 4.2262 6.9724 + -1.0090 2.2150 4.1817 6.9347 k = 0.5000-0.5000 0.5000 ( 392 PWs) bands (ev): - -2.2529 1.0113 8.4844 8.4844 + -2.3179 0.9478 8.4533 8.4533 k = 0.5000 0.1667 0.5000 ( 389 PWs) bands (ev): - -2.6889 2.6247 6.3428 8.3852 + -2.7551 2.5653 6.2971 8.3534 k = 0.0000 0.5000 0.0000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k = 0.0000 1.1667 0.0000 ( 392 PWs) bands (ev): - -1.6970 2.7962 6.4949 6.4949 + -1.7559 2.7223 6.4558 6.4558 k = 0.7500-0.2500 0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.7500 0.4167 0.7500 ( 389 PWs) bands (ev): - -2.9955 3.1058 7.2296 7.7026 + -3.0626 3.0481 7.1869 7.6683 k = 0.5000 0.0000 0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 0.5000 0.6667 0.5000 ( 390 PWs) bands (ev): - -2.4208 1.4864 7.8144 8.4506 + -2.4863 1.4241 7.7774 8.4192 k = 0.0000-1.0000 0.0000 ( 388 PWs) bands (ev): - -0.8103 1.7773 6.3474 6.3474 + -0.8573 1.6897 6.3076 6.3076 k = 0.0000-0.3333 0.0000 ( 371 PWs) bands (ev): - -5.1066 7.7592 8.4270 8.4270 + -5.1789 7.7228 8.3985 8.3985 k =-0.5000-1.0000 0.0000 ( 396 PWs) bands (ev): - -0.5749 2.5599 4.5456 4.8386 + -0.6219 2.4618 4.5064 4.7964 k =-0.5000-0.3333 0.0000 ( 384 PWs) bands (ev): - -3.5733 4.5514 6.1719 8.4404 + -3.6421 4.5000 6.1259 8.4085 k = 0.2500-0.2500-0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.2500 0.4167-0.2500 ( 384 PWs) bands (ev): - -3.9547 4.0533 8.3192 8.5282 + -4.0247 4.0010 8.2887 8.4956 k = 0.2500-0.2500 0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.2500 0.4167 0.2500 ( 384 PWs) bands (ev): - -3.9547 4.0533 8.3192 8.5282 + -4.0247 4.0010 8.2887 8.4956 k =-0.2500 0.2500 0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k =-0.2500 0.9167 0.2500 ( 388 PWs) bands (ev): - -0.9566 2.2990 4.2262 6.9724 + -1.0090 2.2150 4.1817 6.9347 k =-0.5000 0.5000 0.5000 ( 392 PWs) bands (ev): - -2.2529 1.0113 8.4844 8.4844 + -2.3179 0.9478 8.4533 8.4533 k =-0.5000 1.1667 0.5000 ( 389 PWs) bands (ev): - -2.6889 2.6247 6.3428 8.3852 + -2.7551 2.5653 6.2971 8.3534 k = 0.0000 0.0000-0.5000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k = 0.0000 0.6667-0.5000 ( 394 PWs) bands (ev): - -1.8472 2.9440 4.4872 7.4175 + -1.9090 2.8768 4.4373 7.3804 k = 0.0000-0.5000 0.0000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k = 0.0000 0.1667 0.0000 ( 383 PWs) bands (ev): - -5.6445 8.9999 9.1957 9.1957 + -5.7178 8.9736 9.1727 9.1727 k = 0.7500-0.7500 0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.7500-0.0833 0.2500 ( 393 PWs) bands (ev): - -2.0617 3.2552 5.6174 6.6199 + -2.1240 3.1878 5.5709 6.5811 k =-0.7500 0.2500 0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.7500 0.9167 0.7500 ( 383 PWs) bands (ev): - -4.9767 6.5252 8.3075 9.3252 + -5.0488 6.4842 8.2756 9.3011 k = 0.7500 0.7500-0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.7500 1.4167-0.2500 ( 387 PWs) bands (ev): - -1.6468 1.8260 5.7929 7.2994 + -1.7072 1.7585 5.7436 7.2628 k =-0.7500 0.2500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.7500 0.9167-0.7500 ( 383 PWs) bands (ev): - -4.9767 6.5252 8.3075 9.3252 + -5.0488 6.4842 8.2756 9.3011 k = 0.7500-0.2500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.7500 0.4167-0.7500 ( 389 PWs) bands (ev): - -2.9955 3.1058 7.2296 7.7026 + -3.0626 3.0481 7.1869 7.6683 k =-0.7500 0.7500-0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.7500 1.4167-0.2500 ( 387 PWs) bands (ev): - -1.6468 1.8260 5.7929 7.2994 + -1.7072 1.7585 5.7436 7.2628 k =-0.7500-0.7500 0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.7500-0.0833 0.2500 ( 393 PWs) bands (ev): - -2.0617 3.2552 5.6174 6.6199 + -2.1240 3.1878 5.5709 6.5811 k = 0.5000-0.5000 0.0000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 0.5000 0.1667 0.0000 ( 383 PWs) bands (ev): - -4.0624 5.5862 7.1406 8.0094 + -4.1324 5.5380 7.1019 7.9755 k =-0.5000 0.0000 0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k =-0.5000 0.6667 0.5000 ( 390 PWs) bands (ev): - -2.4208 1.4864 7.8144 8.4506 + -2.4863 1.4241 7.7774 8.4192 k = 0.5000 0.5000 0.0000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 0.5000 1.1667 0.0000 ( 391 PWs) bands (ev): - -0.9585 2.6159 4.2107 5.9555 + -1.0117 2.5308 4.1663 5.9146 k = 0.0000 0.0000 1.0000 ( 388 PWs) bands (ev): - -0.8103 1.7773 6.3474 6.3474 + -0.8573 1.6897 6.3076 6.3076 k = 0.0000 0.6667 1.0000 ( 388 PWs) bands (ev): - -0.6382 2.2897 5.0302 5.1456 + -0.6853 2.1972 4.9874 5.1038 k = 0.0000 0.5000 1.0000 ( 396 PWs) bands (ev): - -0.5749 2.5599 4.5456 4.8386 + -0.6219 2.4618 4.5064 4.7964 k = 0.0000 1.1667 1.0000 ( 384 PWs) bands (ev): - -0.7556 1.9204 5.8741 5.9008 + -0.8025 1.8318 5.8336 5.8587 - highest occupied level (ev): 9.5362 + highest occupied level (ev): 9.5160 Writing output data file sic.save/ @@ -1194,7 +1360,8 @@ convergence threshold = 1.0E-14 beta = 0.7000 number of iterations used = 4 - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.23700 celldm(2)= 0.00000 celldm(3)= 0.00000 @@ -1229,14 +1396,17 @@ number of k points= 52 PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -1272,7 +1442,7 @@ Alpha used in Ewald sum = 1.3000 - PHONON : 16.40s CPU 16.99s WALL + PHONON : 18.10s CPU 18.58s WALL @@ -1280,32 +1450,32 @@ Self-consistent Calculation - iter # 1 total cpu time : 17.2 secs av.it.: 6.3 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 4.925E-04 + iter # 1 total cpu time : 18.8 secs av.it.: 6.2 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 4.958E-04 - iter # 2 total cpu time : 17.5 secs av.it.: 7.9 - thresh= 2.219E-03 alpha_mix = 0.700 |ddv_scf|^2 = 1.380E-03 + iter # 2 total cpu time : 19.1 secs av.it.: 8.1 + thresh= 2.227E-03 alpha_mix = 0.700 |ddv_scf|^2 = 1.409E-03 - iter # 3 total cpu time : 17.8 secs av.it.: 7.0 - thresh= 3.715E-03 alpha_mix = 0.700 |ddv_scf|^2 = 2.129E-06 + iter # 3 total cpu time : 19.4 secs av.it.: 7.0 + thresh= 3.754E-03 alpha_mix = 0.700 |ddv_scf|^2 = 2.238E-06 - iter # 4 total cpu time : 18.1 secs av.it.: 8.1 - thresh= 1.459E-04 alpha_mix = 0.700 |ddv_scf|^2 = 1.343E-07 + iter # 4 total cpu time : 19.7 secs av.it.: 8.4 + thresh= 1.496E-04 alpha_mix = 0.700 |ddv_scf|^2 = 1.400E-07 - iter # 5 total cpu time : 18.3 secs av.it.: 7.6 - thresh= 3.665E-05 alpha_mix = 0.700 |ddv_scf|^2 = 6.512E-10 + iter # 5 total cpu time : 19.9 secs av.it.: 7.7 + thresh= 3.742E-05 alpha_mix = 0.700 |ddv_scf|^2 = 6.302E-10 - iter # 6 total cpu time : 18.6 secs av.it.: 7.6 - thresh= 2.552E-06 alpha_mix = 0.700 |ddv_scf|^2 = 3.313E-12 + iter # 6 total cpu time : 20.2 secs av.it.: 7.6 + thresh= 2.510E-06 alpha_mix = 0.700 |ddv_scf|^2 = 3.724E-12 - iter # 7 total cpu time : 18.9 secs av.it.: 7.9 - thresh= 1.820E-07 alpha_mix = 0.700 |ddv_scf|^2 = 6.743E-13 + iter # 7 total cpu time : 20.5 secs av.it.: 8.2 + thresh= 1.930E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.862E-12 - iter # 8 total cpu time : 19.2 secs av.it.: 7.5 - thresh= 8.212E-08 alpha_mix = 0.700 |ddv_scf|^2 = 3.410E-13 + iter # 8 total cpu time : 20.8 secs av.it.: 7.3 + thresh= 1.364E-07 alpha_mix = 0.700 |ddv_scf|^2 = 2.243E-13 - iter # 9 total cpu time : 19.4 secs av.it.: 7.4 - thresh= 5.839E-08 alpha_mix = 0.700 |ddv_scf|^2 = 9.398E-15 + iter # 9 total cpu time : 21.0 secs av.it.: 7.7 + thresh= 4.736E-08 alpha_mix = 0.700 |ddv_scf|^2 = 9.760E-15 End of self-consistent calculation @@ -1316,35 +1486,35 @@ Self-consistent Calculation - iter # 1 total cpu time : 19.7 secs av.it.: 5.8 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.111E-04 + iter # 1 total cpu time : 21.3 secs av.it.: 6.0 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.133E-04 - iter # 2 total cpu time : 19.9 secs av.it.: 7.9 - thresh= 1.453E-03 alpha_mix = 0.700 |ddv_scf|^2 = 6.355E-04 + iter # 2 total cpu time : 21.6 secs av.it.: 8.1 + thresh= 1.460E-03 alpha_mix = 0.700 |ddv_scf|^2 = 6.674E-04 - iter # 3 total cpu time : 20.2 secs av.it.: 7.2 - thresh= 2.521E-03 alpha_mix = 0.700 |ddv_scf|^2 = 2.014E-07 + iter # 3 total cpu time : 21.8 secs av.it.: 7.2 + thresh= 2.583E-03 alpha_mix = 0.700 |ddv_scf|^2 = 1.356E-07 - iter # 4 total cpu time : 20.5 secs av.it.: 7.4 - thresh= 4.487E-05 alpha_mix = 0.700 |ddv_scf|^2 = 7.159E-09 + iter # 4 total cpu time : 22.1 secs av.it.: 8.0 + thresh= 3.682E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.603E-08 - iter # 5 total cpu time : 20.7 secs av.it.: 8.2 - thresh= 8.461E-06 alpha_mix = 0.700 |ddv_scf|^2 = 8.106E-10 + iter # 5 total cpu time : 22.4 secs av.it.: 8.5 + thresh= 1.266E-05 alpha_mix = 0.700 |ddv_scf|^2 = 2.445E-09 - iter # 6 total cpu time : 21.0 secs av.it.: 8.1 - thresh= 2.847E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.370E-12 + iter # 6 total cpu time : 22.7 secs av.it.: 8.1 + thresh= 4.944E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.078E-11 - iter # 7 total cpu time : 21.3 secs av.it.: 8.0 - thresh= 1.540E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.229E-13 + iter # 7 total cpu time : 23.0 secs av.it.: 8.1 + thresh= 3.283E-07 alpha_mix = 0.700 |ddv_scf|^2 = 3.662E-13 - iter # 8 total cpu time : 21.6 secs av.it.: 7.6 - thresh= 3.505E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.304E-14 + iter # 8 total cpu time : 23.3 secs av.it.: 8.4 + thresh= 6.052E-08 alpha_mix = 0.700 |ddv_scf|^2 = 6.275E-13 - iter # 9 total cpu time : 21.8 secs av.it.: 7.7 - thresh= 1.142E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.546E-14 + iter # 9 total cpu time : 23.5 secs av.it.: 7.4 + thresh= 7.921E-08 alpha_mix = 0.700 |ddv_scf|^2 = 2.902E-14 - iter # 10 total cpu time : 22.1 secs av.it.: 7.6 - thresh= 1.244E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.499E-16 + iter # 10 total cpu time : 23.8 secs av.it.: 8.0 + thresh= 1.704E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.196E-15 End of self-consistent calculation @@ -1355,23 +1525,23 @@ Self-consistent Calculation - iter # 1 total cpu time : 22.3 secs av.it.: 5.2 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.856E-06 + iter # 1 total cpu time : 24.0 secs av.it.: 5.2 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.748E-06 - iter # 2 total cpu time : 22.6 secs av.it.: 8.2 - thresh= 1.362E-04 alpha_mix = 0.700 |ddv_scf|^2 = 9.568E-08 + iter # 2 total cpu time : 24.3 secs av.it.: 8.2 + thresh= 1.322E-04 alpha_mix = 0.700 |ddv_scf|^2 = 1.189E-07 - iter # 3 total cpu time : 22.9 secs av.it.: 8.1 - thresh= 3.093E-05 alpha_mix = 0.700 |ddv_scf|^2 = 2.770E-09 + iter # 3 total cpu time : 24.6 secs av.it.: 8.0 + thresh= 3.448E-05 alpha_mix = 0.700 |ddv_scf|^2 = 8.253E-09 - iter # 4 total cpu time : 23.2 secs av.it.: 7.4 - thresh= 5.263E-06 alpha_mix = 0.700 |ddv_scf|^2 = 6.110E-12 + iter # 4 total cpu time : 24.9 secs av.it.: 7.9 + thresh= 9.084E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.497E-11 - iter # 5 total cpu time : 23.5 secs av.it.: 8.0 - thresh= 2.472E-07 alpha_mix = 0.700 |ddv_scf|^2 = 5.108E-14 + iter # 5 total cpu time : 25.2 secs av.it.: 8.2 + thresh= 3.869E-07 alpha_mix = 0.700 |ddv_scf|^2 = 2.334E-13 - iter # 6 total cpu time : 23.7 secs av.it.: 7.9 - thresh= 2.260E-08 alpha_mix = 0.700 |ddv_scf|^2 = 5.664E-16 + iter # 6 total cpu time : 25.5 secs av.it.: 8.0 + thresh= 4.831E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.296E-15 End of self-consistent calculation @@ -1382,23 +1552,23 @@ Self-consistent Calculation - iter # 1 total cpu time : 24.0 secs av.it.: 5.8 + iter # 1 total cpu time : 25.7 secs av.it.: 5.9 thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.488E-05 - iter # 2 total cpu time : 24.3 secs av.it.: 8.3 - thresh= 3.858E-04 alpha_mix = 0.700 |ddv_scf|^2 = 7.963E-07 + iter # 2 total cpu time : 26.0 secs av.it.: 8.4 + thresh= 3.858E-04 alpha_mix = 0.700 |ddv_scf|^2 = 7.991E-07 - iter # 3 total cpu time : 24.5 secs av.it.: 8.1 - thresh= 8.924E-05 alpha_mix = 0.700 |ddv_scf|^2 = 3.161E-09 + iter # 3 total cpu time : 26.3 secs av.it.: 8.2 + thresh= 8.939E-05 alpha_mix = 0.700 |ddv_scf|^2 = 3.165E-09 - iter # 4 total cpu time : 24.8 secs av.it.: 7.5 - thresh= 5.622E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.867E-11 + iter # 4 total cpu time : 26.6 secs av.it.: 7.7 + thresh= 5.626E-06 alpha_mix = 0.700 |ddv_scf|^2 = 3.253E-11 - iter # 5 total cpu time : 25.1 secs av.it.: 7.8 - thresh= 5.355E-07 alpha_mix = 0.700 |ddv_scf|^2 = 6.881E-14 + iter # 5 total cpu time : 26.8 secs av.it.: 8.0 + thresh= 5.704E-07 alpha_mix = 0.700 |ddv_scf|^2 = 6.506E-14 - iter # 6 total cpu time : 25.4 secs av.it.: 7.8 - thresh= 2.623E-08 alpha_mix = 0.700 |ddv_scf|^2 = 2.648E-15 + iter # 6 total cpu time : 27.1 secs av.it.: 7.9 + thresh= 2.551E-08 alpha_mix = 0.700 |ddv_scf|^2 = 2.400E-15 End of self-consistent calculation @@ -1409,23 +1579,23 @@ Self-consistent Calculation - iter # 1 total cpu time : 25.6 secs av.it.: 5.8 + iter # 1 total cpu time : 27.4 secs av.it.: 6.0 thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.488E-05 - iter # 2 total cpu time : 25.9 secs av.it.: 8.3 - thresh= 3.858E-04 alpha_mix = 0.700 |ddv_scf|^2 = 7.961E-07 + iter # 2 total cpu time : 27.7 secs av.it.: 8.4 + thresh= 3.858E-04 alpha_mix = 0.700 |ddv_scf|^2 = 7.993E-07 - iter # 3 total cpu time : 26.2 secs av.it.: 8.1 - thresh= 8.923E-05 alpha_mix = 0.700 |ddv_scf|^2 = 3.161E-09 + iter # 3 total cpu time : 28.0 secs av.it.: 8.2 + thresh= 8.940E-05 alpha_mix = 0.700 |ddv_scf|^2 = 3.166E-09 - iter # 4 total cpu time : 26.4 secs av.it.: 7.5 - thresh= 5.622E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.867E-11 + iter # 4 total cpu time : 28.2 secs av.it.: 7.7 + thresh= 5.626E-06 alpha_mix = 0.700 |ddv_scf|^2 = 3.255E-11 - iter # 5 total cpu time : 26.7 secs av.it.: 7.8 - thresh= 5.354E-07 alpha_mix = 0.700 |ddv_scf|^2 = 6.891E-14 + iter # 5 total cpu time : 28.5 secs av.it.: 8.0 + thresh= 5.705E-07 alpha_mix = 0.700 |ddv_scf|^2 = 6.499E-14 - iter # 6 total cpu time : 27.0 secs av.it.: 7.8 - thresh= 2.625E-08 alpha_mix = 0.700 |ddv_scf|^2 = 2.646E-15 + iter # 6 total cpu time : 28.8 secs av.it.: 8.0 + thresh= 2.549E-08 alpha_mix = 0.700 |ddv_scf|^2 = 2.404E-15 End of self-consistent calculation @@ -1436,23 +1606,23 @@ Self-consistent Calculation - iter # 1 total cpu time : 27.2 secs av.it.: 5.2 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.856E-06 + iter # 1 total cpu time : 29.0 secs av.it.: 5.2 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.748E-06 - iter # 2 total cpu time : 27.5 secs av.it.: 8.2 - thresh= 1.362E-04 alpha_mix = 0.700 |ddv_scf|^2 = 9.586E-08 + iter # 2 total cpu time : 29.3 secs av.it.: 8.2 + thresh= 1.322E-04 alpha_mix = 0.700 |ddv_scf|^2 = 1.191E-07 - iter # 3 total cpu time : 27.8 secs av.it.: 8.1 - thresh= 3.096E-05 alpha_mix = 0.700 |ddv_scf|^2 = 2.772E-09 + iter # 3 total cpu time : 29.6 secs av.it.: 8.0 + thresh= 3.451E-05 alpha_mix = 0.700 |ddv_scf|^2 = 8.260E-09 - iter # 4 total cpu time : 28.0 secs av.it.: 7.4 - thresh= 5.265E-06 alpha_mix = 0.700 |ddv_scf|^2 = 6.070E-12 + iter # 4 total cpu time : 29.9 secs av.it.: 7.9 + thresh= 9.088E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.500E-11 - iter # 5 total cpu time : 28.3 secs av.it.: 8.1 - thresh= 2.464E-07 alpha_mix = 0.700 |ddv_scf|^2 = 5.078E-14 + iter # 5 total cpu time : 30.2 secs av.it.: 8.2 + thresh= 3.873E-07 alpha_mix = 0.700 |ddv_scf|^2 = 2.339E-13 - iter # 6 total cpu time : 28.6 secs av.it.: 7.8 - thresh= 2.254E-08 alpha_mix = 0.700 |ddv_scf|^2 = 5.542E-16 + iter # 6 total cpu time : 30.4 secs av.it.: 8.1 + thresh= 4.836E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.279E-15 End of self-consistent calculation @@ -1472,22 +1642,22 @@ q = ( 0.000000000 0.666666667 0.000000000 ) ************************************************************************** - freq ( 1) = 10.163469 [THz] = 339.016844 [cm-1] - freq ( 2) = 10.163469 [THz] = 339.016844 [cm-1] - freq ( 3) = 15.399918 [THz] = 513.685983 [cm-1] - freq ( 4) = 23.205261 [THz] = 774.044176 [cm-1] - freq ( 5) = 23.205261 [THz] = 774.044176 [cm-1] - freq ( 6) = 26.873134 [THz] = 896.391273 [cm-1] + freq ( 1) = 10.173595 [THz] = 339.354585 [cm-1] + freq ( 2) = 10.173595 [THz] = 339.354585 [cm-1] + freq ( 3) = 15.387069 [THz] = 513.257366 [cm-1] + freq ( 4) = 23.364684 [THz] = 779.361970 [cm-1] + freq ( 5) = 23.364684 [THz] = 779.361970 [cm-1] + freq ( 6) = 27.005967 [THz] = 900.822111 [cm-1] ************************************************************************** Mode symmetry, C_2v (mm2) point group: - freq ( 1 - 1) = 339.0 [cm-1] --> B_1 D_3 S_3 - freq ( 2 - 2) = 339.0 [cm-1] --> B_2 D_4 S_4 - freq ( 3 - 3) = 513.7 [cm-1] --> A_1 D_1 S_1 - freq ( 4 - 4) = 774.0 [cm-1] --> B_1 D_3 S_3 - freq ( 5 - 5) = 774.0 [cm-1] --> B_2 D_4 S_4 - freq ( 6 - 6) = 896.4 [cm-1] --> A_1 D_1 S_1 + freq ( 1 - 1) = 339.4 [cm-1] --> B_1 D_3 S_3 + freq ( 2 - 2) = 339.4 [cm-1] --> B_2 D_4 S_4 + freq ( 3 - 3) = 513.3 [cm-1] --> A_1 D_1 S_1 + freq ( 4 - 4) = 779.4 [cm-1] --> B_1 D_3 S_3 + freq ( 5 - 5) = 779.4 [cm-1] --> B_2 D_4 S_4 + freq ( 6 - 6) = 900.8 [cm-1] --> A_1 D_1 S_1 Calculation of q = 0.6666667 -0.0000000 0.6666667 @@ -1510,7 +1680,8 @@ number of Kohn-Sham states= 4 kinetic-energy cutoff = 30.0000 Ry charge density cutoff = 120.0000 Ry - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.237000 celldm(2)= 0.000000 celldm(3)= 0.000000 celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000 @@ -1527,14 +1698,17 @@ PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -1648,7 +1822,9 @@ Dense grid: 3119 G-vectors FFT dimensions: ( 24, 24, 24) - Estimated max dynamical RAM per process > 4.32 MB + Estimated max dynamical RAM per process > 4.34 MB + + Check: negative core charge= -0.000002 The potential is recalculated from file : ./_ph0/sic.q_4/sic.save/charge-density @@ -1658,333 +1834,333 @@ Band Structure Calculation Davidson diagonalization with overlap - ethr = 1.25E-10, avg # of iterations = 11.1 + ethr = 1.25E-10, avg # of iterations = 11.5 - total cpu time spent up to now is 2.7 secs + total cpu time spent up to now is 3.3 secs End of band structure calculation k = 0.0000 0.0000 0.0000 ( 387 PWs) bands (ev): - -5.8255 9.5362 9.5362 9.5362 + -5.8991 9.5160 9.5160 9.5160 k = 0.6667-0.0000 0.6667 ( 389 PWs) bands (ev): - -1.1906 2.5291 3.9023 7.3625 + -1.2467 2.4493 3.8572 7.3262 k =-0.2500 0.2500-0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.4167 0.2500 0.4167 ( 384 PWs) bands (ev): - -3.3274 2.8851 7.8226 8.7195 + -3.3958 2.8284 7.7865 8.6901 k = 0.5000-0.5000 0.5000 ( 392 PWs) bands (ev): - -2.2529 1.0113 8.4844 8.4844 + -2.3179 0.9478 8.4533 8.4533 k = 1.1667-0.5000 1.1667 ( 383 PWs) bands (ev): - -3.8995 4.7785 7.7454 7.7928 + -3.9692 4.7278 7.7066 7.7595 k = 0.0000 0.5000 0.0000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k = 0.6667 0.5000 0.6667 ( 383 PWs) bands (ev): - -3.0032 2.3505 8.2005 8.2293 + -3.0707 2.2918 8.1653 8.1976 k = 0.7500-0.2500 0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 1.4167-0.2500 1.4167 ( 389 PWs) bands (ev): - -1.9319 1.5407 6.4585 8.0240 + -1.9945 1.4758 6.4126 7.9904 k = 0.5000 0.0000 0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 1.1667-0.0000 1.1667 ( 385 PWs) bands (ev): - -0.7393 2.0490 4.7840 6.6170 + -0.7869 1.9595 4.7411 6.5781 k = 0.0000-1.0000 0.0000 ( 388 PWs) bands (ev): - -0.8103 1.7773 6.3474 6.3474 + -0.8573 1.6897 6.3076 6.3076 k = 0.6667-1.0000 0.6667 ( 385 PWs) bands (ev): - -4.4118 5.6464 7.1045 9.1598 + -4.4827 5.6014 7.0635 9.1335 k =-0.5000-1.0000 0.0000 ( 396 PWs) bands (ev): - -0.5749 2.5599 4.5456 4.8386 + -0.6219 2.4618 4.5064 4.7964 k = 0.1667-1.0000 0.6667 ( 395 PWs) bands (ev): - -1.2959 2.7757 5.0298 5.8107 + -1.3525 2.6975 4.9829 5.7706 k = 0.2500 0.2500 0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.9167 0.2500 0.9167 ( 388 PWs) bands (ev): - -2.3150 3.5760 6.2829 6.7411 + -2.3784 3.5090 6.2420 6.7029 k = 0.2500-0.2500-0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.9167-0.2500 0.4167 ( 391 PWs) bands (ev): - -1.1820 2.3328 4.3324 6.9377 + -1.2379 2.2566 4.2835 6.8993 k = 0.2500-0.2500 0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.9167-0.2500 0.9167 ( 388 PWs) bands (ev): - -2.3150 3.5760 6.2829 6.7411 + -2.3784 3.5090 6.2420 6.7029 k =-0.2500 0.2500 0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.4167 0.2500 0.9167 ( 391 PWs) bands (ev): - -1.1820 2.3328 4.3324 6.9377 + -1.2379 2.2566 4.2835 6.8993 k =-0.2500-0.2500-0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.4167-0.2500 0.4167 ( 384 PWs) bands (ev): - -3.3274 2.8851 7.8226 8.7195 + -3.3958 2.8284 7.7865 8.6901 k =-0.5000-0.5000-0.5000 ( 392 PWs) bands (ev): - -2.2529 1.0113 8.4844 8.4844 + -2.3179 0.9478 8.4533 8.4533 k = 0.1667-0.5000 0.1667 ( 383 PWs) bands (ev): - -3.8995 4.7785 7.7454 7.7928 + -3.9692 4.7278 7.7066 7.7595 k =-0.5000 0.5000 0.5000 ( 392 PWs) bands (ev): - -2.2529 1.0113 8.4844 8.4844 + -2.3179 0.9478 8.4533 8.4533 k = 0.1667 0.5000 1.1667 ( 386 PWs) bands (ev): - -1.1732 2.1864 4.8326 6.4132 + -1.2290 2.1117 4.7818 6.3738 k = 0.0000 0.0000-0.5000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k = 0.6667-0.0000 0.1667 ( 389 PWs) bands (ev): - -2.9038 4.2514 6.4371 6.9359 + -2.9700 4.1912 6.3951 6.8980 k = 0.5000 0.0000 0.0000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k = 1.1667-0.0000 0.6667 ( 386 PWs) bands (ev): - -0.7620 2.3561 4.0661 6.4440 + -0.8116 2.2651 4.0249 6.4041 k = 0.0000-0.5000 0.0000 ( 375 PWs) bands (ev): - -4.2290 6.2175 7.6016 7.6016 + -4.2994 6.1699 7.5679 7.5679 k = 0.6667-0.5000 0.6667 ( 383 PWs) bands (ev): - -3.0032 2.3505 8.2005 8.2293 + -3.0707 2.2918 8.1653 8.1976 k =-0.7500-0.2500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.0833-0.2500-0.0833 ( 373 PWs) bands (ev): - -5.3304 7.7249 8.8573 9.1095 + -5.4031 7.6906 8.8314 9.0843 k = 0.7500-0.7500 0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 1.4167-0.7500 0.9167 ( 381 PWs) bands (ev): - -4.2824 5.3232 7.4170 8.7613 + -4.3531 5.2761 7.3789 8.7318 k =-0.2500-0.7500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.4167-0.7500-0.0833 ( 390 PWs) bands (ev): - -1.6248 2.7085 4.9376 6.6155 + -1.6847 2.6389 4.8875 6.5762 k =-0.7500 0.2500 0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.0833 0.2500 1.4167 ( 389 PWs) bands (ev): - -3.2817 4.2512 6.5160 7.6393 + -3.3496 4.1963 6.4721 7.6033 k = 0.7500 0.7500-0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 1.4167 0.7500 0.4167 ( 386 PWs) bands (ev): - -2.4839 2.0702 7.0238 8.0789 + -2.5494 2.0089 6.9811 8.0454 k =-0.7500 0.7500 0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.0833 0.7500 0.9167 ( 388 PWs) bands (ev): - -0.9263 2.3114 4.9525 6.1543 + -0.9775 2.2261 4.9092 6.1138 k =-0.7500 0.2500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.0833 0.2500-0.0833 ( 373 PWs) bands (ev): - -5.3304 7.7249 8.8573 9.1095 + -5.4031 7.6906 8.8314 9.0843 k = 0.7500-0.2500-0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 1.4167-0.2500-0.0833 ( 389 PWs) bands (ev): - -3.2817 4.2512 6.5160 7.6393 + -3.3496 4.1963 6.4721 7.6033 k = 0.7500 0.2500 0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 1.4167 0.2500 1.4167 ( 389 PWs) bands (ev): - -1.9319 1.5407 6.4585 8.0240 + -1.9945 1.4758 6.4126 7.9904 k =-0.7500 0.7500-0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.0833 0.7500 0.4167 ( 390 PWs) bands (ev): - -1.6248 2.7085 4.9376 6.6155 + -1.6847 2.6389 4.8875 6.5762 k =-0.7500-0.7500 0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k =-0.0833-0.7500 0.9167 ( 388 PWs) bands (ev): - -0.9263 2.3114 4.9525 6.1543 + -0.9775 2.2261 4.9092 6.1138 k = 0.7500 0.7500 0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 1.4167 0.7500 0.9167 ( 381 PWs) bands (ev): - -4.2824 5.3232 7.4170 8.7613 + -4.3531 5.2761 7.3789 8.7318 k = 0.7500-0.7500-0.2500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 1.4167-0.7500 0.4167 ( 386 PWs) bands (ev): - -2.4839 2.0702 7.0238 8.0789 + -2.5494 2.0089 6.9811 8.0454 k =-0.5000 0.0000-0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 0.1667-0.0000 0.1667 ( 379 PWs) bands (ev): - -5.4648 8.0751 8.8281 9.4881 + -5.5378 8.0431 8.8012 9.4665 k = 0.5000-0.5000 0.0000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 1.1667-0.5000 0.6667 ( 387 PWs) bands (ev): - -3.4242 3.5946 7.1334 8.3962 + -3.4928 3.5397 7.0926 8.3640 k = 0.0000-0.5000-0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 0.6667-0.5000 0.1667 ( 387 PWs) bands (ev): - -1.8353 2.0808 5.5882 7.5467 + -1.8970 2.0154 5.5387 7.5105 k =-0.5000 0.0000 0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 0.1667-0.0000 1.1667 ( 392 PWs) bands (ev): - -1.5867 2.8115 5.9978 6.1821 + -1.6451 2.7366 5.9549 6.1427 k = 0.5000 0.5000 0.0000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 1.1667 0.5000 0.6667 ( 387 PWs) bands (ev): - -3.4242 3.5946 7.1334 8.3962 + -3.4928 3.5397 7.0926 8.3640 k =-0.5000 0.5000 0.0000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5594 5.1536 8.3214 k = 0.1667 0.5000 0.6667 ( 387 PWs) bands (ev): - -1.8353 2.0808 5.5882 7.5467 + -1.8970 2.0154 5.5387 7.5105 k = 0.0000 0.0000 1.0000 ( 388 PWs) bands (ev): - -0.8103 1.7773 6.3474 6.3474 + -0.8573 1.6897 6.3076 6.3076 k = 0.6667-0.0000 1.6667 ( 397 PWs) bands (ev): - -2.4770 3.6098 5.4401 7.1169 + -2.5418 3.5483 5.3918 7.0786 k = 0.5000-1.0000 0.0000 ( 396 PWs) bands (ev): - -0.5749 2.5599 4.5456 4.8386 + -0.6219 2.4618 4.5064 4.7964 k = 1.1667-1.0000 0.6667 ( 381 PWs) bands (ev): - -4.9312 6.8477 8.0091 9.0129 + -5.0031 6.8081 7.9756 8.9862 k = 0.0000 0.5000 1.0000 ( 396 PWs) bands (ev): - -0.5749 2.5599 4.5456 4.8386 + -0.6219 2.4618 4.5064 4.7964 k = 0.6667 0.5000 1.6667 ( 390 PWs) bands (ev): - -1.9556 1.3390 7.0043 7.9495 + -2.0186 1.2741 6.9607 7.9155 - highest occupied level (ev): 9.5362 + highest occupied level (ev): 9.5160 Writing output data file sic.save/ @@ -2000,7 +2176,8 @@ convergence threshold = 1.0E-14 beta = 0.7000 number of iterations used = 4 - Exchange-correlation = PBE ( 1 4 3 4 0 0) + Exchange-correlation= PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.23700 celldm(2)= 0.00000 celldm(3)= 0.00000 @@ -2035,14 +2212,17 @@ number of k points= 80 PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -2078,7 +2258,7 @@ Alpha used in Ewald sum = 1.3000 - PHONON : 29.21s CPU 30.11s WALL + PHONON : 31.40s CPU 32.20s WALL @@ -2086,32 +2266,32 @@ Self-consistent Calculation - iter # 1 total cpu time : 30.5 secs av.it.: 5.9 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.842E-05 + iter # 1 total cpu time : 32.5 secs av.it.: 5.9 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.676E-05 - iter # 2 total cpu time : 30.9 secs av.it.: 8.8 - thresh= 5.331E-04 alpha_mix = 0.700 |ddv_scf|^2 = 3.089E-05 + iter # 2 total cpu time : 33.0 secs av.it.: 8.8 + thresh= 5.173E-04 alpha_mix = 0.700 |ddv_scf|^2 = 3.147E-05 - iter # 3 total cpu time : 31.4 secs av.it.: 8.0 - thresh= 5.558E-04 alpha_mix = 0.700 |ddv_scf|^2 = 5.733E-07 + iter # 3 total cpu time : 33.4 secs av.it.: 8.1 + thresh= 5.610E-04 alpha_mix = 0.700 |ddv_scf|^2 = 5.155E-07 - iter # 4 total cpu time : 31.8 secs av.it.: 8.0 - thresh= 7.572E-05 alpha_mix = 0.700 |ddv_scf|^2 = 7.275E-09 + iter # 4 total cpu time : 33.9 secs av.it.: 8.3 + thresh= 7.180E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.872E-08 - iter # 5 total cpu time : 32.2 secs av.it.: 8.2 - thresh= 8.530E-06 alpha_mix = 0.700 |ddv_scf|^2 = 9.029E-10 + iter # 5 total cpu time : 34.3 secs av.it.: 8.5 + thresh= 1.368E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.631E-09 - iter # 6 total cpu time : 32.7 secs av.it.: 8.3 - thresh= 3.005E-06 alpha_mix = 0.700 |ddv_scf|^2 = 7.520E-11 + iter # 6 total cpu time : 34.8 secs av.it.: 8.3 + thresh= 4.038E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.315E-11 - iter # 7 total cpu time : 33.1 secs av.it.: 8.2 - thresh= 8.672E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.102E-13 + iter # 7 total cpu time : 35.2 secs av.it.: 8.4 + thresh= 4.811E-07 alpha_mix = 0.700 |ddv_scf|^2 = 3.923E-13 - iter # 8 total cpu time : 33.6 secs av.it.: 8.6 - thresh= 3.320E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.436E-14 + iter # 8 total cpu time : 35.6 secs av.it.: 8.6 + thresh= 6.264E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.021E-13 - iter # 9 total cpu time : 34.0 secs av.it.: 8.4 - thresh= 1.198E-08 alpha_mix = 0.700 |ddv_scf|^2 = 6.113E-15 + iter # 9 total cpu time : 36.1 secs av.it.: 8.3 + thresh= 3.195E-08 alpha_mix = 0.700 |ddv_scf|^2 = 2.604E-15 End of self-consistent calculation @@ -2122,35 +2302,32 @@ Self-consistent Calculation - iter # 1 total cpu time : 34.4 secs av.it.: 6.1 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 6.488E-05 - - iter # 2 total cpu time : 34.8 secs av.it.: 8.7 - thresh= 8.055E-04 alpha_mix = 0.700 |ddv_scf|^2 = 2.650E-05 + iter # 1 total cpu time : 36.5 secs av.it.: 6.2 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 6.484E-05 - iter # 3 total cpu time : 35.3 secs av.it.: 8.1 - thresh= 5.148E-04 alpha_mix = 0.700 |ddv_scf|^2 = 8.484E-07 + iter # 2 total cpu time : 36.9 secs av.it.: 8.7 + thresh= 8.052E-04 alpha_mix = 0.700 |ddv_scf|^2 = 2.651E-05 - iter # 4 total cpu time : 35.7 secs av.it.: 8.0 - thresh= 9.211E-05 alpha_mix = 0.700 |ddv_scf|^2 = 9.804E-09 + iter # 3 total cpu time : 37.3 secs av.it.: 8.3 + thresh= 5.149E-04 alpha_mix = 0.700 |ddv_scf|^2 = 8.687E-07 - iter # 5 total cpu time : 36.1 secs av.it.: 8.1 - thresh= 9.901E-06 alpha_mix = 0.700 |ddv_scf|^2 = 7.406E-10 + iter # 4 total cpu time : 37.8 secs av.it.: 8.1 + thresh= 9.320E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.046E-08 - iter # 6 total cpu time : 36.6 secs av.it.: 8.3 - thresh= 2.721E-06 alpha_mix = 0.700 |ddv_scf|^2 = 7.383E-11 + iter # 5 total cpu time : 38.2 secs av.it.: 8.2 + thresh= 1.023E-05 alpha_mix = 0.700 |ddv_scf|^2 = 7.887E-10 - iter # 7 total cpu time : 37.0 secs av.it.: 8.4 - thresh= 8.592E-07 alpha_mix = 0.700 |ddv_scf|^2 = 2.943E-12 + iter # 6 total cpu time : 38.7 secs av.it.: 8.4 + thresh= 2.808E-06 alpha_mix = 0.700 |ddv_scf|^2 = 8.265E-11 - iter # 8 total cpu time : 37.5 secs av.it.: 8.2 - thresh= 1.715E-07 alpha_mix = 0.700 |ddv_scf|^2 = 9.742E-14 + iter # 7 total cpu time : 39.1 secs av.it.: 8.5 + thresh= 9.091E-07 alpha_mix = 0.700 |ddv_scf|^2 = 3.375E-12 - iter # 9 total cpu time : 37.9 secs av.it.: 8.2 - thresh= 3.121E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.129E-14 + iter # 8 total cpu time : 39.5 secs av.it.: 8.3 + thresh= 1.837E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.001E-13 - iter # 10 total cpu time : 38.3 secs av.it.: 8.2 - thresh= 1.062E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.350E-15 + iter # 9 total cpu time : 40.0 secs av.it.: 8.4 + thresh= 3.163E-08 alpha_mix = 0.700 |ddv_scf|^2 = 7.811E-15 End of self-consistent calculation @@ -2161,32 +2338,32 @@ Self-consistent Calculation - iter # 1 total cpu time : 38.7 secs av.it.: 6.2 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.014E-04 + iter # 1 total cpu time : 40.4 secs av.it.: 6.4 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.022E-04 - iter # 2 total cpu time : 39.2 secs av.it.: 8.4 - thresh= 1.007E-03 alpha_mix = 0.700 |ddv_scf|^2 = 7.196E-05 + iter # 2 total cpu time : 40.8 secs av.it.: 8.7 + thresh= 1.011E-03 alpha_mix = 0.700 |ddv_scf|^2 = 7.416E-05 - iter # 3 total cpu time : 39.6 secs av.it.: 7.9 - thresh= 8.483E-04 alpha_mix = 0.700 |ddv_scf|^2 = 6.682E-07 + iter # 3 total cpu time : 41.2 secs av.it.: 7.9 + thresh= 8.612E-04 alpha_mix = 0.700 |ddv_scf|^2 = 6.789E-07 - iter # 4 total cpu time : 40.0 secs av.it.: 8.0 - thresh= 8.174E-05 alpha_mix = 0.700 |ddv_scf|^2 = 2.574E-08 + iter # 4 total cpu time : 41.7 secs av.it.: 8.2 + thresh= 8.239E-05 alpha_mix = 0.700 |ddv_scf|^2 = 3.060E-08 - iter # 5 total cpu time : 40.5 secs av.it.: 8.1 - thresh= 1.604E-05 alpha_mix = 0.700 |ddv_scf|^2 = 5.055E-10 + iter # 5 total cpu time : 42.1 secs av.it.: 8.3 + thresh= 1.749E-05 alpha_mix = 0.700 |ddv_scf|^2 = 5.438E-10 - iter # 6 total cpu time : 40.9 secs av.it.: 8.4 - thresh= 2.248E-06 alpha_mix = 0.700 |ddv_scf|^2 = 5.378E-11 + iter # 6 total cpu time : 42.6 secs av.it.: 8.5 + thresh= 2.332E-06 alpha_mix = 0.700 |ddv_scf|^2 = 5.690E-11 - iter # 7 total cpu time : 41.3 secs av.it.: 8.2 - thresh= 7.333E-07 alpha_mix = 0.700 |ddv_scf|^2 = 4.709E-13 + iter # 7 total cpu time : 43.0 secs av.it.: 8.4 + thresh= 7.543E-07 alpha_mix = 0.700 |ddv_scf|^2 = 8.302E-13 - iter # 8 total cpu time : 41.8 secs av.it.: 8.4 - thresh= 6.862E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.470E-14 + iter # 8 total cpu time : 43.4 secs av.it.: 8.6 + thresh= 9.112E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.211E-14 - iter # 9 total cpu time : 42.2 secs av.it.: 8.6 - thresh= 1.213E-08 alpha_mix = 0.700 |ddv_scf|^2 = 9.654E-15 + iter # 9 total cpu time : 43.9 secs av.it.: 8.6 + thresh= 1.101E-08 alpha_mix = 0.700 |ddv_scf|^2 = 3.520E-15 End of self-consistent calculation @@ -2197,32 +2374,32 @@ Self-consistent Calculation - iter # 1 total cpu time : 42.6 secs av.it.: 5.9 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.838E-05 + iter # 1 total cpu time : 44.2 secs av.it.: 5.9 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 2.683E-05 - iter # 2 total cpu time : 43.0 secs av.it.: 8.8 - thresh= 5.327E-04 alpha_mix = 0.700 |ddv_scf|^2 = 3.140E-05 + iter # 2 total cpu time : 44.7 secs av.it.: 8.8 + thresh= 5.180E-04 alpha_mix = 0.700 |ddv_scf|^2 = 3.220E-05 - iter # 3 total cpu time : 43.5 secs av.it.: 8.0 - thresh= 5.604E-04 alpha_mix = 0.700 |ddv_scf|^2 = 5.577E-07 + iter # 3 total cpu time : 45.1 secs av.it.: 8.1 + thresh= 5.675E-04 alpha_mix = 0.700 |ddv_scf|^2 = 4.967E-07 - iter # 4 total cpu time : 43.9 secs av.it.: 8.0 - thresh= 7.468E-05 alpha_mix = 0.700 |ddv_scf|^2 = 7.714E-09 + iter # 4 total cpu time : 45.6 secs av.it.: 8.2 + thresh= 7.047E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.882E-08 - iter # 5 total cpu time : 44.3 secs av.it.: 8.2 - thresh= 8.783E-06 alpha_mix = 0.700 |ddv_scf|^2 = 8.740E-10 + iter # 5 total cpu time : 46.0 secs av.it.: 8.4 + thresh= 1.372E-05 alpha_mix = 0.700 |ddv_scf|^2 = 1.568E-09 - iter # 6 total cpu time : 44.8 secs av.it.: 8.2 - thresh= 2.956E-06 alpha_mix = 0.700 |ddv_scf|^2 = 7.883E-11 + iter # 6 total cpu time : 46.5 secs av.it.: 8.3 + thresh= 3.960E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.520E-11 - iter # 7 total cpu time : 45.2 secs av.it.: 8.2 - thresh= 8.879E-07 alpha_mix = 0.700 |ddv_scf|^2 = 1.197E-13 + iter # 7 total cpu time : 46.9 secs av.it.: 8.4 + thresh= 5.020E-07 alpha_mix = 0.700 |ddv_scf|^2 = 3.994E-13 - iter # 8 total cpu time : 45.7 secs av.it.: 8.6 - thresh= 3.460E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.228E-14 + iter # 8 total cpu time : 47.3 secs av.it.: 8.6 + thresh= 6.320E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.005E-13 - iter # 9 total cpu time : 46.1 secs av.it.: 8.2 - thresh= 1.108E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.942E-15 + iter # 9 total cpu time : 47.8 secs av.it.: 8.3 + thresh= 3.170E-08 alpha_mix = 0.700 |ddv_scf|^2 = 4.683E-15 End of self-consistent calculation @@ -2233,23 +2410,23 @@ Self-consistent Calculation - iter # 1 total cpu time : 46.5 secs av.it.: 5.8 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.293E-05 + iter # 1 total cpu time : 48.1 secs av.it.: 5.8 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.294E-05 - iter # 2 total cpu time : 46.9 secs av.it.: 8.4 - thresh= 3.596E-04 alpha_mix = 0.700 |ddv_scf|^2 = 5.583E-07 + iter # 2 total cpu time : 48.6 secs av.it.: 8.4 + thresh= 3.597E-04 alpha_mix = 0.700 |ddv_scf|^2 = 5.602E-07 - iter # 3 total cpu time : 47.4 secs av.it.: 8.2 - thresh= 7.472E-05 alpha_mix = 0.700 |ddv_scf|^2 = 3.003E-09 + iter # 3 total cpu time : 49.0 secs av.it.: 8.3 + thresh= 7.485E-05 alpha_mix = 0.700 |ddv_scf|^2 = 2.999E-09 - iter # 4 total cpu time : 47.8 secs av.it.: 7.4 - thresh= 5.480E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.715E-11 + iter # 4 total cpu time : 49.4 secs av.it.: 7.6 + thresh= 5.476E-06 alpha_mix = 0.700 |ddv_scf|^2 = 2.994E-11 - iter # 5 total cpu time : 48.3 secs av.it.: 7.7 - thresh= 5.211E-07 alpha_mix = 0.700 |ddv_scf|^2 = 6.262E-14 + iter # 5 total cpu time : 49.8 secs av.it.: 7.8 + thresh= 5.472E-07 alpha_mix = 0.700 |ddv_scf|^2 = 5.997E-14 - iter # 6 total cpu time : 48.7 secs av.it.: 7.8 - thresh= 2.502E-08 alpha_mix = 0.700 |ddv_scf|^2 = 2.119E-15 + iter # 6 total cpu time : 50.3 secs av.it.: 7.8 + thresh= 2.449E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.950E-15 End of self-consistent calculation @@ -2260,23 +2437,23 @@ Self-consistent Calculation - iter # 1 total cpu time : 49.0 secs av.it.: 5.0 - thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.429E-06 + iter # 1 total cpu time : 50.6 secs av.it.: 5.0 + thresh= 1.000E-02 alpha_mix = 0.700 |ddv_scf|^2 = 1.446E-06 - iter # 2 total cpu time : 49.5 secs av.it.: 8.3 - thresh= 1.195E-04 alpha_mix = 0.700 |ddv_scf|^2 = 6.184E-08 + iter # 2 total cpu time : 51.0 secs av.it.: 8.2 + thresh= 1.203E-04 alpha_mix = 0.700 |ddv_scf|^2 = 9.576E-08 - iter # 3 total cpu time : 49.9 secs av.it.: 8.1 - thresh= 2.487E-05 alpha_mix = 0.700 |ddv_scf|^2 = 2.600E-09 + iter # 3 total cpu time : 51.5 secs av.it.: 7.9 + thresh= 3.094E-05 alpha_mix = 0.700 |ddv_scf|^2 = 6.604E-09 - iter # 4 total cpu time : 50.4 secs av.it.: 7.4 - thresh= 5.099E-06 alpha_mix = 0.700 |ddv_scf|^2 = 6.893E-12 + iter # 4 total cpu time : 51.9 secs av.it.: 7.9 + thresh= 8.126E-06 alpha_mix = 0.700 |ddv_scf|^2 = 1.338E-11 - iter # 5 total cpu time : 50.8 secs av.it.: 7.9 - thresh= 2.625E-07 alpha_mix = 0.700 |ddv_scf|^2 = 5.192E-14 + iter # 5 total cpu time : 52.3 secs av.it.: 8.3 + thresh= 3.658E-07 alpha_mix = 0.700 |ddv_scf|^2 = 2.161E-13 - iter # 6 total cpu time : 51.3 secs av.it.: 7.9 - thresh= 2.279E-08 alpha_mix = 0.700 |ddv_scf|^2 = 7.297E-16 + iter # 6 total cpu time : 52.7 secs av.it.: 8.0 + thresh= 4.648E-08 alpha_mix = 0.700 |ddv_scf|^2 = 1.455E-15 End of self-consistent calculation @@ -2302,140 +2479,142 @@ q = ( 0.666666667 -0.000000000 0.666666667 ) ************************************************************************** - freq ( 1) = 10.499925 [THz] = 350.239797 [cm-1] - freq ( 2) = 14.121210 [THz] = 471.032871 [cm-1] - freq ( 3) = 15.946329 [THz] = 531.912270 [cm-1] - freq ( 4) = 22.790338 [THz] = 760.203834 [cm-1] - freq ( 5) = 22.943618 [THz] = 765.316734 [cm-1] - freq ( 6) = 26.111554 [THz] = 870.987688 [cm-1] + freq ( 1) = 10.514983 [THz] = 350.742078 [cm-1] + freq ( 2) = 14.116725 [THz] = 470.883262 [cm-1] + freq ( 3) = 15.931092 [THz] = 531.404023 [cm-1] + freq ( 4) = 22.952227 [THz] = 765.603887 [cm-1] + freq ( 5) = 23.123944 [THz] = 771.331736 [cm-1] + freq ( 6) = 26.235898 [THz] = 875.135371 [cm-1] ************************************************************************** Mode symmetry, C_s (m) point group: - freq ( 1 - 1) = 350.2 [cm-1] --> A'' - freq ( 2 - 2) = 471.0 [cm-1] --> A' - freq ( 3 - 3) = 531.9 [cm-1] --> A' - freq ( 4 - 4) = 760.2 [cm-1] --> A'' - freq ( 5 - 5) = 765.3 [cm-1] --> A' - freq ( 6 - 6) = 871.0 [cm-1] --> A' + freq ( 1 - 1) = 350.7 [cm-1] --> A'' + freq ( 2 - 2) = 470.9 [cm-1] --> A' + freq ( 3 - 3) = 531.4 [cm-1] --> A' + freq ( 4 - 4) = 765.6 [cm-1] --> A'' + freq ( 5 - 5) = 771.3 [cm-1] --> A' + freq ( 6 - 6) = 875.1 [cm-1] --> A' - init_run : 0.33s CPU 0.33s WALL ( 3 calls) - electrons : 2.29s CPU 2.35s WALL ( 3 calls) + init_run : 0.82s CPU 0.82s WALL ( 4 calls) + electrons : 2.41s CPU 2.47s WALL ( 4 calls) Called by init_run: - wfcinit : 0.00s CPU 0.00s WALL ( 3 calls) - potinit : 0.02s CPU 0.02s WALL ( 3 calls) - hinit0 : 0.30s CPU 0.30s WALL ( 3 calls) + wfcinit : 0.00s CPU 0.00s WALL ( 4 calls) + potinit : 0.03s CPU 0.03s WALL ( 4 calls) + hinit0 : 0.78s CPU 0.78s WALL ( 4 calls) Called by electrons: - c_bands : 2.29s CPU 2.35s WALL ( 3 calls) - v_of_rho : 0.03s CPU 0.03s WALL ( 4 calls) - newd : 0.01s CPU 0.01s WALL ( 4 calls) + c_bands : 2.41s CPU 2.47s WALL ( 4 calls) + v_of_rho : 0.03s CPU 0.03s WALL ( 5 calls) + newd : 0.01s CPU 0.01s WALL ( 5 calls) Called by c_bands: - init_us_2 : 0.34s CPU 0.36s WALL ( 4934 calls) - cegterg : 1.93s CPU 1.98s WALL ( 172 calls) + init_us_2 : 0.34s CPU 0.35s WALL ( 4902 calls) + cegterg : 2.04s CPU 2.09s WALL ( 180 calls) Called by sum_band: Called by *egterg: - h_psi : 34.79s CPU 35.68s WALL ( 43292 calls) - s_psi : 0.97s CPU 1.00s WALL ( 88710 calls) - g_psi : 0.01s CPU 0.01s WALL ( 1920 calls) - cdiaghg : 0.07s CPU 0.07s WALL ( 2092 calls) + h_psi : 34.36s CPU 35.16s WALL ( 43885 calls) + s_psi : 1.19s CPU 1.22s WALL ( 89691 calls) + g_psi : 0.01s CPU 0.01s WALL ( 2069 calls) + cdiaghg : 0.07s CPU 0.07s WALL ( 2249 calls) Called by h_psi: - h_psi:pot : 34.70s CPU 35.58s WALL ( 43292 calls) - h_psi:calbec : 0.82s CPU 0.84s WALL ( 43292 calls) - vloc_psi : 33.27s CPU 34.11s WALL ( 43292 calls) - add_vuspsi : 0.53s CPU 0.54s WALL ( 43292 calls) + h_psi:pot : 34.26s CPU 35.06s WALL ( 43885 calls) + h_psi:calbec : 0.94s CPU 0.96s WALL ( 43885 calls) + vloc_psi : 32.58s CPU 33.34s WALL ( 43885 calls) + add_vuspsi : 0.63s CPU 0.65s WALL ( 43885 calls) General routines - calbec : 1.45s CPU 1.50s WALL ( 99508 calls) - fft : 0.38s CPU 0.41s WALL ( 2517 calls) - ffts : 0.11s CPU 0.12s WALL ( 744 calls) - fftw : 37.54s CPU 38.53s WALL ( 379484 calls) - davcio : 0.21s CPU 0.26s WALL ( 23784 calls) + calbec : 1.67s CPU 1.72s WALL ( 100449 calls) + fft : 0.48s CPU 0.50s WALL ( 3238 calls) + ffts : 0.11s CPU 0.11s WALL ( 744 calls) + fftw : 36.56s CPU 37.44s WALL ( 382384 calls) + davcio : 0.19s CPU 0.22s WALL ( 23579 calls) Parallel routines - PHONON : 49.85s CPU 51.30s WALL + PHONON : 51.46s CPU 52.76s WALL INITIALIZATION: - phq_setup : 0.08s CPU 0.09s WALL ( 4 calls) - phq_init : 0.73s CPU 0.75s WALL ( 4 calls) + phq_setup : 0.09s CPU 0.09s WALL ( 4 calls) + phq_init : 1.28s CPU 1.30s WALL ( 4 calls) - phq_init : 0.73s CPU 0.75s WALL ( 4 calls) - init_vloc : 0.00s CPU 0.00s WALL ( 4 calls) - init_us_1 : 0.29s CPU 0.29s WALL ( 4 calls) - newd : 0.01s CPU 0.01s WALL ( 4 calls) - dvanqq : 0.04s CPU 0.04s WALL ( 4 calls) - drho : 0.42s CPU 0.43s WALL ( 4 calls) + phq_init : 1.28s CPU 1.30s WALL ( 4 calls) + set_drhoc : 0.44s CPU 0.44s WALL ( 12 calls) + init_vloc : 0.01s CPU 0.01s WALL ( 5 calls) + init_us_1 : 0.82s CPU 0.82s WALL ( 5 calls) + newd : 0.01s CPU 0.01s WALL ( 5 calls) + dvanqq : 0.07s CPU 0.07s WALL ( 4 calls) + drho : 0.44s CPU 0.46s WALL ( 4 calls) DYNAMICAL MATRIX: - dynmat0 : 0.07s CPU 0.07s WALL ( 4 calls) - phqscf : 44.03s CPU 45.30s WALL ( 4 calls) + dynmat0 : 0.39s CPU 0.40s WALL ( 4 calls) + phqscf : 44.05s CPU 45.18s WALL ( 4 calls) dynmatrix : 0.01s CPU 0.01s WALL ( 4 calls) - phqscf : 44.03s CPU 45.30s WALL ( 4 calls) - solve_linter : 43.87s CPU 45.12s WALL ( 18 calls) - drhodv : 0.09s CPU 0.11s WALL ( 18 calls) + phqscf : 44.05s CPU 45.18s WALL ( 4 calls) + solve_linter : 43.86s CPU 44.98s WALL ( 18 calls) + drhodv : 0.11s CPU 0.12s WALL ( 18 calls) - dynmat0 : 0.07s CPU 0.07s WALL ( 4 calls) + dynmat0 : 0.39s CPU 0.40s WALL ( 4 calls) dynmat_us : 0.06s CPU 0.06s WALL ( 4 calls) d2ionq : 0.01s CPU 0.01s WALL ( 4 calls) + dynmatcc : 0.32s CPU 0.32s WALL ( 4 calls) dynmat_us : 0.06s CPU 0.06s WALL ( 4 calls) addusdynmat : 0.00s CPU 0.00s WALL ( 4 calls) - phqscf : 44.03s CPU 45.30s WALL ( 4 calls) - solve_linter : 43.87s CPU 45.12s WALL ( 18 calls) - - solve_linter : 43.87s CPU 45.12s WALL ( 18 calls) - dvqpsi_us : 0.69s CPU 0.72s WALL ( 612 calls) - ortho : 0.18s CPU 0.18s WALL ( 4366 calls) - cgsolve : 35.34s CPU 36.24s WALL ( 4366 calls) - incdrhoscf : 4.08s CPU 4.18s WALL ( 4366 calls) - addusddens : 0.35s CPU 0.35s WALL ( 152 calls) - vpsifft : 3.28s CPU 3.38s WALL ( 3634 calls) - dv_of_drho : 0.42s CPU 0.45s WALL ( 187 calls) - mix_pot : 0.08s CPU 0.10s WALL ( 140 calls) - psymdvscf : 0.42s CPU 0.43s WALL ( 134 calls) - newdq : 0.30s CPU 0.35s WALL ( 140 calls) - adddvscf : 0.03s CPU 0.03s WALL ( 3754 calls) + phqscf : 44.05s CPU 45.18s WALL ( 4 calls) + solve_linter : 43.86s CPU 44.98s WALL ( 18 calls) + + solve_linter : 43.86s CPU 44.98s WALL ( 18 calls) + dvqpsi_us : 0.69s CPU 0.70s WALL ( 612 calls) + ortho : 0.19s CPU 0.20s WALL ( 4326 calls) + cgsolve : 35.14s CPU 35.95s WALL ( 4326 calls) + incdrhoscf : 3.91s CPU 4.00s WALL ( 4326 calls) + addusddens : 0.57s CPU 0.58s WALL ( 151 calls) + vpsifft : 3.16s CPU 3.25s WALL ( 3594 calls) + dv_of_drho : 0.43s CPU 0.44s WALL ( 186 calls) + mix_pot : 0.09s CPU 0.10s WALL ( 139 calls) + psymdvscf : 0.42s CPU 0.43s WALL ( 133 calls) + newdq : 0.54s CPU 0.59s WALL ( 139 calls) + adddvscf : 0.05s CPU 0.05s WALL ( 3714 calls) drhodvus : 0.00s CPU 0.00s WALL ( 18 calls) - dvqpsi_us : 0.69s CPU 0.72s WALL ( 612 calls) - dvqpsi_us_on : 0.04s CPU 0.04s WALL ( 612 calls) + dvqpsi_us : 0.69s CPU 0.70s WALL ( 612 calls) + dvqpsi_us_on : 0.05s CPU 0.05s WALL ( 612 calls) - cgsolve : 35.34s CPU 36.24s WALL ( 4366 calls) - ch_psi : 35.02s CPU 35.91s WALL ( 41028 calls) + cgsolve : 35.14s CPU 35.95s WALL ( 4326 calls) + ch_psi : 34.83s CPU 35.63s WALL ( 41456 calls) - ch_psi : 35.02s CPU 35.91s WALL ( 41028 calls) - h_psi : 34.79s CPU 35.68s WALL ( 43292 calls) - last : 1.57s CPU 1.61s WALL ( 41028 calls) + ch_psi : 34.83s CPU 35.63s WALL ( 41456 calls) + h_psi : 34.36s CPU 35.16s WALL ( 43885 calls) + last : 1.76s CPU 1.81s WALL ( 41456 calls) - h_psi : 34.79s CPU 35.68s WALL ( 43292 calls) - add_vuspsi : 0.53s CPU 0.54s WALL ( 43292 calls) + h_psi : 34.36s CPU 35.16s WALL ( 43885 calls) + add_vuspsi : 0.63s CPU 0.65s WALL ( 43885 calls) - incdrhoscf : 4.08s CPU 4.18s WALL ( 4366 calls) - addusdbec : 0.08s CPU 0.08s WALL ( 4930 calls) + incdrhoscf : 3.91s CPU 4.00s WALL ( 4326 calls) + addusdbec : 0.09s CPU 0.09s WALL ( 4890 calls) drhodvus : 0.00s CPU 0.00s WALL ( 18 calls) General routines - calbec : 1.45s CPU 1.50s WALL ( 99508 calls) - fft : 0.38s CPU 0.41s WALL ( 2517 calls) - ffts : 0.11s CPU 0.12s WALL ( 744 calls) - fftw : 37.54s CPU 38.53s WALL ( 379484 calls) - davcio : 0.21s CPU 0.26s WALL ( 23784 calls) - write_rec : 0.13s CPU 0.15s WALL ( 158 calls) + calbec : 1.67s CPU 1.72s WALL ( 100449 calls) + fft : 0.48s CPU 0.50s WALL ( 3238 calls) + ffts : 0.11s CPU 0.11s WALL ( 744 calls) + fftw : 36.56s CPU 37.44s WALL ( 382384 calls) + davcio : 0.19s CPU 0.22s WALL ( 23579 calls) + write_rec : 0.12s CPU 0.13s WALL ( 157 calls) - PHONON : 49.85s CPU 51.30s WALL + PHONON : 51.46s CPU 52.76s WALL - This run was terminated on: 19: 6:14 18Jan2019 + This run was terminated on: 11:28:22 18Jul2019 =------------------------------------------------------------------------------= JOB DONE. diff --git a/test-suite/epw_trev_uspp/benchmark.out.git.inp=scf.in.args=1 b/test-suite/epw_trev_uspp/benchmark.out.git.inp=scf.in.args=1 index 7b56f441ea..f626961331 100644 --- a/test-suite/epw_trev_uspp/benchmark.out.git.inp=scf.in.args=1 +++ b/test-suite/epw_trev_uspp/benchmark.out.git.inp=scf.in.args=1 @@ -1,5 +1,5 @@ - Program PWSCF v.6.3 starts on 18Jan2019 at 19: 5:21 + Program PWSCF v.6.4.1 starts on 18Jul2019 at 11:28:22 This program is part of the open-source Quantum ESPRESSO suite for quantum simulation of materials; please cite @@ -44,7 +44,8 @@ convergence threshold = 1.0E-10 mixing beta = 0.7000 number of iterations used = 8 plain mixing - Exchange-correlation = SLA PW PBE PBE ( 1 4 3 4 0 0) + Exchange-correlation= SLA PW PBE PBE + ( 1 4 3 4 0 0 0) celldm(1)= 8.237000 celldm(2)= 0.000000 celldm(3)= 0.000000 celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000 @@ -61,14 +62,17 @@ PseudoPot. # 1 for Si read from file: - ../../pseudo/Si.pbe-rrkj.UPF - MD5 check sum: 8af8e7039d270e0118f3b3651cf51d3d - Pseudo is Norm-conserving, Zval = 4.0 - Generated by new atomic code, or converted to UPF format - Using radial grid of 883 points, 3 beta functions with: + ../../pseudo/Si.pbe-nl-rrkjus_psl.1.0.0.UPF + MD5 check sum: 78279d3766ecb5dbdc0623f3e93c9a23 + Pseudo is Ultrasoft + core correction, Zval = 4.0 + Generated using "atomic" code by A. Dal Corso v.6.3 + Using radial grid of 1141 points, 4 beta functions with: l(1) = 0 l(2) = 0 l(3) = 1 + l(4) = 1 + Q(r) pseudized with 0 coefficients + PseudoPot. # 2 for C read from file: ../../pseudo/C.pbe-rrkjus.UPF @@ -110,14 +114,16 @@ Dense grid: 3119 G-vectors FFT dimensions: ( 24, 24, 24) - Estimated max dynamical RAM per process > 5.38 MB + Estimated max dynamical RAM per process > 5.40 MB + + Check: negative core charge= -0.000002 Initial potential from superposition of free atoms starting charge 7.99939, renormalised to 8.00000 Starting wfcs are 8 randomized atomic wfcs - total cpu time spent up to now is 0.2 secs + total cpu time spent up to now is 0.5 secs Self-consistent Calculation @@ -125,216 +131,206 @@ Davidson diagonalization with overlap ethr = 1.00E-02, avg # of iterations = 2.0 - total cpu time spent up to now is 0.3 secs + total cpu time spent up to now is 0.6 secs - total energy = -19.14016527 Ry - Harris-Foulkes estimate = -19.41192268 Ry - estimated scf accuracy < 0.42347350 Ry + total energy = -21.48329643 Ry + Harris-Foulkes estimate = -21.77304394 Ry + estimated scf accuracy < 0.44286148 Ry iteration # 2 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 5.29E-03, avg # of iterations = 2.0 + ethr = 5.54E-03, avg # of iterations = 2.1 - total cpu time spent up to now is 0.3 secs + total cpu time spent up to now is 0.6 secs - total energy = -19.25283855 Ry - Harris-Foulkes estimate = -19.32122380 Ry - estimated scf accuracy < 0.13086165 Ry + total energy = -21.60591440 Ry + Harris-Foulkes estimate = -21.68347279 Ry + estimated scf accuracy < 0.14835687 Ry iteration # 3 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 1.64E-03, avg # of iterations = 2.0 + ethr = 1.85E-03, avg # of iterations = 2.0 - total cpu time spent up to now is 0.4 secs + total cpu time spent up to now is 0.6 secs - total energy = -19.27745392 Ry - Harris-Foulkes estimate = -19.27748085 Ry - estimated scf accuracy < 0.00110385 Ry + total energy = -21.63339442 Ry + Harris-Foulkes estimate = -21.63361364 Ry + estimated scf accuracy < 0.00130047 Ry iteration # 4 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 1.38E-05, avg # of iterations = 2.8 + ethr = 1.63E-05, avg # of iterations = 3.0 - total cpu time spent up to now is 0.4 secs + total cpu time spent up to now is 0.7 secs - total energy = -19.27786642 Ry - Harris-Foulkes estimate = -19.27795176 Ry - estimated scf accuracy < 0.00025424 Ry + total energy = -21.63397367 Ry + Harris-Foulkes estimate = -21.63411453 Ry + estimated scf accuracy < 0.00042434 Ry iteration # 5 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 3.18E-06, avg # of iterations = 1.0 + ethr = 5.30E-06, avg # of iterations = 1.0 - total cpu time spent up to now is 0.4 secs + total cpu time spent up to now is 0.7 secs - total energy = -19.27784922 Ry - Harris-Foulkes estimate = -19.27787975 Ry - estimated scf accuracy < 0.00006040 Ry + total energy = -21.63392788 Ry + Harris-Foulkes estimate = -21.63399441 Ry + estimated scf accuracy < 0.00011765 Ry iteration # 6 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 7.55E-07, avg # of iterations = 2.0 + ethr = 1.47E-06, avg # of iterations = 2.1 - total cpu time spent up to now is 0.5 secs + total cpu time spent up to now is 0.8 secs - total energy = -19.27786813 Ry - Harris-Foulkes estimate = -19.27787002 Ry - estimated scf accuracy < 0.00000439 Ry + total energy = -21.63396631 Ry + Harris-Foulkes estimate = -21.63397103 Ry + estimated scf accuracy < 0.00001150 Ry iteration # 7 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 5.49E-08, avg # of iterations = 2.0 + ethr = 1.44E-07, avg # of iterations = 2.0 - total cpu time spent up to now is 0.5 secs + total cpu time spent up to now is 0.8 secs - total energy = -19.27786885 Ry - Harris-Foulkes estimate = -19.27786888 Ry - estimated scf accuracy < 0.00000022 Ry + total energy = -21.63396754 Ry + Harris-Foulkes estimate = -21.63396782 Ry + estimated scf accuracy < 0.00000091 Ry iteration # 8 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 2.70E-09, avg # of iterations = 1.9 + ethr = 1.13E-08, avg # of iterations = 2.0 - total cpu time spent up to now is 0.5 secs + total cpu time spent up to now is 0.8 secs - total energy = -19.27786885 Ry - Harris-Foulkes estimate = -19.27786887 Ry - estimated scf accuracy < 0.00000006 Ry + total energy = -21.63396764 Ry + Harris-Foulkes estimate = -21.63396768 Ry + estimated scf accuracy < 0.00000008 Ry iteration # 9 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 7.28E-10, avg # of iterations = 2.0 + ethr = 1.01E-09, avg # of iterations = 2.5 - total cpu time spent up to now is 0.6 secs + total cpu time spent up to now is 0.9 secs - total energy = -19.27786886 Ry - Harris-Foulkes estimate = -19.27786886 Ry - estimated scf accuracy < 8.7E-10 Ry + total energy = -21.63396767 Ry + Harris-Foulkes estimate = -21.63396768 Ry + estimated scf accuracy < 0.00000001 Ry iteration # 10 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 1.09E-11, avg # of iterations = 2.4 + ethr = 1.28E-10, avg # of iterations = 2.0 - total cpu time spent up to now is 0.6 secs + total cpu time spent up to now is 0.9 secs - total energy = -19.27786886 Ry - Harris-Foulkes estimate = -19.27786886 Ry - estimated scf accuracy < 2.2E-10 Ry + total energy = -21.63396767 Ry + Harris-Foulkes estimate = -21.63396767 Ry + estimated scf accuracy < 1.1E-09 Ry iteration # 11 ecut= 30.00 Ry beta= 0.70 Davidson diagonalization with overlap - ethr = 2.73E-12, avg # of iterations = 2.0 + ethr = 1.38E-11, avg # of iterations = 2.4 - total cpu time spent up to now is 0.7 secs - - total energy = -19.27786886 Ry - Harris-Foulkes estimate = -19.27786886 Ry - estimated scf accuracy < 1.3E-10 Ry - - iteration # 12 ecut= 30.00 Ry beta= 0.70 - Davidson diagonalization with overlap - ethr = 1.68E-12, avg # of iterations = 1.0 - - total cpu time spent up to now is 0.7 secs + total cpu time spent up to now is 0.9 secs End of self-consistent calculation k = 0.0000 0.0000 0.0000 ( 387 PWs) bands (ev): - -5.8255 9.5362 9.5362 9.5362 + -5.8991 9.5160 9.5160 9.5160 k =-0.2500 0.2500-0.2500 ( 380 PWs) bands (ev): - -4.6304 5.2576 8.9302 8.9302 + -4.7019 5.2106 8.9035 8.9035 k = 0.5000-0.5000 0.5000 ( 392 PWs) bands (ev): - -2.2529 1.0113 8.4844 8.4844 + -2.3179 0.9478 8.4534 8.4534 k = 0.0000 0.5000 0.0000 ( 375 PWs) bands (ev): - -4.2290 6.2176 7.6016 7.6016 + -4.2994 6.1699 7.5680 7.5680 k = 0.7500-0.2500 0.7500 ( 390 PWs) bands (ev): - -1.8750 2.4979 5.5890 7.2270 + -1.9365 2.4313 5.5403 7.1904 k = 0.5000 0.0000 0.5000 ( 399 PWs) bands (ev): - -2.8012 3.6168 5.2040 8.3536 + -2.8677 3.5595 5.1536 8.3214 k = 0.0000-1.0000 0.0000 ( 388 PWs) bands (ev): - -0.8103 1.7774 6.3474 6.3474 + -0.8572 1.6897 6.3077 6.3077 k =-0.5000-1.0000 0.0000 ( 396 PWs) bands (ev): - -0.5749 2.5599 4.5456 4.8386 + -0.6219 2.4618 4.5064 4.7964 - highest occupied level (ev): 9.5362 + highest occupied level (ev): 9.5160 -! total energy = -19.27786886 Ry - Harris-Foulkes estimate = -19.27786886 Ry - estimated scf accuracy < 3.0E-11 Ry +! total energy = -21.63396767 Ry + Harris-Foulkes estimate = -21.63396767 Ry + estimated scf accuracy < 8.4E-11 Ry The total energy is the sum of the following terms: - one-electron contribution = 5.39182822 Ry - hartree contribution = 2.35894511 Ry - xc contribution = -6.10141896 Ry + one-electron contribution = 5.55779227 Ry + hartree contribution = 2.35753432 Ry + xc contribution = -8.62207103 Ry ewald contribution = -20.92722324 Ry - convergence has been achieved in 12 iterations + convergence has been achieved in 11 iterations Writing output data file sic.save/ - init_run : 0.12s CPU 0.13s WALL ( 1 calls) - electrons : 0.43s CPU 0.44s WALL ( 1 calls) + init_run : 0.22s CPU 0.22s WALL ( 1 calls) + electrons : 0.41s CPU 0.41s WALL ( 1 calls) Called by init_run: wfcinit : 0.02s CPU 0.02s WALL ( 1 calls) potinit : 0.01s CPU 0.01s WALL ( 1 calls) - hinit0 : 0.09s CPU 0.10s WALL ( 1 calls) + hinit0 : 0.19s CPU 0.19s WALL ( 1 calls) Called by electrons: - c_bands : 0.26s CPU 0.27s WALL ( 12 calls) - sum_band : 0.07s CPU 0.07s WALL ( 12 calls) - v_of_rho : 0.08s CPU 0.08s WALL ( 13 calls) - newd : 0.02s CPU 0.02s WALL ( 13 calls) - mix_rho : 0.00s CPU 0.00s WALL ( 12 calls) + c_bands : 0.25s CPU 0.25s WALL ( 11 calls) + sum_band : 0.07s CPU 0.07s WALL ( 11 calls) + v_of_rho : 0.07s CPU 0.07s WALL ( 12 calls) + newd : 0.02s CPU 0.02s WALL ( 12 calls) + mix_rho : 0.00s CPU 0.00s WALL ( 11 calls) Called by c_bands: - init_us_2 : 0.01s CPU 0.01s WALL ( 200 calls) - cegterg : 0.25s CPU 0.26s WALL ( 96 calls) + init_us_2 : 0.01s CPU 0.01s WALL ( 184 calls) + cegterg : 0.24s CPU 0.24s WALL ( 88 calls) Called by sum_band: - sum_band:bec : 0.00s CPU 0.00s WALL ( 96 calls) - addusdens : 0.01s CPU 0.02s WALL ( 12 calls) + sum_band:bec : 0.00s CPU 0.00s WALL ( 88 calls) + addusdens : 0.02s CPU 0.02s WALL ( 11 calls) Called by *egterg: - h_psi : 0.24s CPU 0.25s WALL ( 288 calls) - s_psi : 0.00s CPU 0.00s WALL ( 288 calls) - g_psi : 0.00s CPU 0.00s WALL ( 184 calls) - cdiaghg : 0.01s CPU 0.01s WALL ( 280 calls) + h_psi : 0.23s CPU 0.23s WALL ( 281 calls) + s_psi : 0.00s CPU 0.00s WALL ( 281 calls) + g_psi : 0.00s CPU 0.00s WALL ( 185 calls) + cdiaghg : 0.01s CPU 0.01s WALL ( 273 calls) Called by h_psi: - h_psi:pot : 0.24s CPU 0.25s WALL ( 288 calls) - h_psi:calbec : 0.01s CPU 0.01s WALL ( 288 calls) - vloc_psi : 0.23s CPU 0.23s WALL ( 288 calls) - add_vuspsi : 0.00s CPU 0.00s WALL ( 288 calls) + h_psi:pot : 0.23s CPU 0.23s WALL ( 281 calls) + h_psi:calbec : 0.01s CPU 0.01s WALL ( 281 calls) + vloc_psi : 0.21s CPU 0.21s WALL ( 281 calls) + add_vuspsi : 0.00s CPU 0.00s WALL ( 281 calls) General routines - calbec : 0.01s CPU 0.01s WALL ( 384 calls) - fft : 0.02s CPU 0.02s WALL ( 142 calls) - ffts : 0.00s CPU 0.00s WALL ( 12 calls) - fftw : 0.24s CPU 0.25s WALL ( 2650 calls) + calbec : 0.01s CPU 0.01s WALL ( 369 calls) + fft : 0.02s CPU 0.02s WALL ( 132 calls) + ffts : 0.00s CPU 0.00s WALL ( 11 calls) + fftw : 0.23s CPU 0.23s WALL ( 2504 calls) Parallel routines - PWSCF : 0.67s CPU 0.69s WALL + PWSCF : 0.95s CPU 0.95s WALL - This run was terminated on: 19: 5:22 18Jan2019 + This run was terminated on: 11:28:23 18Jul2019 =------------------------------------------------------------------------------= JOB DONE. diff --git a/test-suite/epw_trev_uspp/nscf.in b/test-suite/epw_trev_uspp/nscf.in index d4b0af6594..c2048a160d 100644 --- a/test-suite/epw_trev_uspp/nscf.in +++ b/test-suite/epw_trev_uspp/nscf.in @@ -20,7 +20,7 @@ conv_thr = 1.0d-10 / ATOMIC_SPECIES - Si 28.0855 Si.pbe-rrkj.UPF + Si 28.0855 Si.pbe-nl-rrkjus_psl.1.0.0.UPF C 12.01078 C.pbe-rrkjus.UPF ATOMIC_POSITIONS alat Si 0.00 0.00 0.00 diff --git a/test-suite/epw_trev_uspp/scf.in b/test-suite/epw_trev_uspp/scf.in index 9a5396b3bc..f0b92048f4 100644 --- a/test-suite/epw_trev_uspp/scf.in +++ b/test-suite/epw_trev_uspp/scf.in @@ -19,7 +19,7 @@ conv_thr = 1.0d-10 / ATOMIC_SPECIES - Si 28.0855 Si.pbe-rrkj.UPF + Si 28.0855 Si.pbe-nl-rrkjus_psl.1.0.0.UPF C 12.01078 C.pbe-rrkjus.UPF ATOMIC_POSITIONS alat Si 0.00 0.00 0.00 From 537144e4d1ff5ecd66336b5822d3066ce9ca0aad Mon Sep 17 00:00:00 2001 From: giannozz Date: Thu, 18 Jul 2019 15:00:25 +0200 Subject: [PATCH 81/95] With no k-points on some processor, routine efermig had an out-of-bound error --- PW/src/efermig.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/PW/src/efermig.f90 b/PW/src/efermig.f90 index f850a824f8..8285954e78 100644 --- a/PW/src/efermig.f90 +++ b/PW/src/efermig.f90 @@ -30,11 +30,13 @@ FUNCTION efermig (et, nbnd, nks, nelec, wk, Degauss, Ngauss, is, isk) real(DP), external:: sumkg integer :: i, kpoint, Ngauss_ ! - ! find bounds for the Fermi energy. Very safe choice! + ! find (very safe) bounds for the Fermi energy: + ! Elw = lowest, Eup = highest energy among all k-points + ! Works with distributed k-points, also if nks=0 on some processor ! - Elw = et (1, 1) - Eup = et (nbnd, 1) - do kpoint = 2, nks + Elw = 1.0E+8 + Eup =-1.0E+8 + do kpoint = 1, nks Elw = min (Elw, et (1, kpoint) ) Eup = max (Eup, et (nbnd, kpoint) ) enddo From a9bc99e345e2cc1006bd240a50cf17766bc8ab29 Mon Sep 17 00:00:00 2001 From: Samuel Ponce Date: Thu, 18 Jul 2019 22:42:09 +0100 Subject: [PATCH 82/95] Update test-farm to add MPI+openMP test. --- test-suite/buildbot/farmer_gcc640_serial.cfg | 10 +- .../buildbot/farmer_gcc730_openmpi1107.cfg | 26 ++ .../buildbot/farmer_intel12_openmpi.cfg | 7 +- test-suite/buildbot/farmer_intel17_impi.cfg | 13 +- .../buildbot/farmer_intel17_mvapich23.cfg | 41 +++ .../buildbot/farmer_intel17_openmpi313.cfg | 41 +++ .../buildbot/farmer_intel18_mvapich23.cfg | 41 +++ .../buildbot/farmer_intel18_openmpi313.cfg | 41 +++ .../farmer_intel18_openmpi313_openmp.cfg | 41 +++ .../buildbot/farmer_pgi18_mvapich23b.cfg | 30 +++ test-suite/buildbot/master.cfg | 250 ++++++++++++++---- test-suite/buildbot/slave.py | 232 +++++++++++----- test-suite/userconfig.tmp | 8 +- 13 files changed, 646 insertions(+), 135 deletions(-) create mode 100644 test-suite/buildbot/farmer_gcc730_openmpi1107.cfg create mode 100644 test-suite/buildbot/farmer_intel17_mvapich23.cfg create mode 100644 test-suite/buildbot/farmer_intel17_openmpi313.cfg create mode 100644 test-suite/buildbot/farmer_intel18_mvapich23.cfg create mode 100644 test-suite/buildbot/farmer_intel18_openmpi313.cfg create mode 100644 test-suite/buildbot/farmer_intel18_openmpi313_openmp.cfg create mode 100644 test-suite/buildbot/farmer_pgi18_mvapich23b.cfg diff --git a/test-suite/buildbot/farmer_gcc640_serial.cfg b/test-suite/buildbot/farmer_gcc640_serial.cfg index c1765694fb..497b166b70 100644 --- a/test-suite/buildbot/farmer_gcc640_serial.cfg +++ b/test-suite/buildbot/farmer_gcc640_serial.cfg @@ -4,8 +4,8 @@ from slave import Steps Environ={ -'LD_LIBRARY_PATH' : '/mnt/buildbot/local/gcc640/lib64:/mnt/buildbot/local/gcc640/lib32/:/usr/local/lib64:/usr/local/lib', -'PATH' : '/mnt/buildbot/local/gcc640/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games', +'LD_LIBRARY_PATH' : '/mnt/buildbot/binary/gcc640/lib64:/mnt/buildbot/binary/gcc640/lib32/:/usr/local/lib64:/usr/local/lib', +'PATH' : '/mnt/buildbot/binary/gcc640/bin:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', 'LANG' : 'en_GB.UTF-8' } @@ -15,9 +15,9 @@ f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe+Step.dep_qe+Step.ma Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+Step.test_serial_PW+\ Step.test_serial_CP+Step.test_serial_PH+Step.test_serial_EPW) -f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ - Step.make_pw2+Step.make_lr+Step.make_sgw) +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw) f_WAN=BuildFactory(Step.checkout_wannier+Step.cpconfig+Step.clean_wannier+Step.make_wannier+\ - Step.make_wannier2+Step.test_wannier_serial+Step.test_wannier_para) + Step.make_wannier2+Step.clean_tests+Step.test_wannier_serial) diff --git a/test-suite/buildbot/farmer_gcc730_openmpi1107.cfg b/test-suite/buildbot/farmer_gcc730_openmpi1107.cfg new file mode 100644 index 0000000000..d898ad416f --- /dev/null +++ b/test-suite/buildbot/farmer_gcc730_openmpi1107.cfg @@ -0,0 +1,26 @@ +# -*- python -*- +# ex: set syntax=python: + +from slave import Steps + +Environ={ +'LD_LIBRARY_PATH' : '/mnt/buildbot/binary/openmpi1107_gcc730/lib:/mnt/buildbot/binary/gcc730/lib64:/mnt/buildbot/binary/gcc730/lib32/:/usr/local/lib64:/usr/local/lib', +'PATH' : '/mnt/buildbot/binary/openmpi1107_gcc730/bin:/mnt/buildbot/binary/gcc730/bin:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', +'LANG' : 'en_GB.UTF-8' +} + +Step = Steps(Environ) + + +f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe+Step.dep_qe+Step.make_pw+\ + Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ + Step.test_para_PW+Step.test_para_CP+Step.test_para_PH+Step.test_para_EPW) + +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw+Step.test_sgw) + +f_WAN=BuildFactory(Step.checkout_wannier+Step.cpgcc730+Step.clean_wannier+Step.make_wannier+\ + Step.make_wannier2+Step.clean_tests+Step.test_wannier_serial+Step.clean_tests+Step.test_wannier_para) + +#f_test=BuildFactory(Step.clean) + diff --git a/test-suite/buildbot/farmer_intel12_openmpi.cfg b/test-suite/buildbot/farmer_intel12_openmpi.cfg index 9503d06cfe..e6bae7145e 100644 --- a/test-suite/buildbot/farmer_intel12_openmpi.cfg +++ b/test-suite/buildbot/farmer_intel12_openmpi.cfg @@ -20,7 +20,8 @@ Environ={ 'MPIF90_F90' : 'ifort', 'MPICXX_CXX' : 'icpc', 'LD_LIBRARY_PATH' : '/mnt/buildbot/local/openmpi-1.10.7_intel12/lib:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/ipp/../compiler/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/ipp/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/mkl/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/tbb/lib/intel64/cc4.1.0_libc2.4_kernel2.6.16.21:/mnt/buildbot/local/openmpi-1.10.7_intel12/lib:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/usr/local/lib64:/usr/local/lib:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/debugger/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/mpirt/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/usr/local/lib64:/usr/local/lib', -'PATH' : '/mnt/buildbot/local/openmpi-1.10.7_intel12/bin:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/bin/intel64/:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/mpirt/bin/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games', +#'PATH' : '/mnt/buildbot/local/openmpi-1.10.7_intel12/bin:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/bin/intel64/:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/mpirt/bin/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games', +'PATH' : '/mnt/buildbot/local/openmpi-1.10.7_intel12/bin:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/bin/intel64/:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/mpirt/bin/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/bin:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', 'MKLROOT' : '/mnt/buildbot/local/intel12/mkl', } @@ -31,8 +32,8 @@ f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.m Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ Step.test_para_PW+Step.test_para_CP+Step.test_para_PH+Step.test_para_EPW) -f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ - Step.make_pw2+Step.make_lr+Step.make_sgw) #+Step.test_sgw+Step.test_clean_sgw) +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw+Step.test_sgw) f_WAN=BuildFactory(Step.checkout_wannier+Step.cpconfig+Step.clean_wannier+Step.make_wannier+\ Step.make_wannier2+Step.test_wannier_serial+Step.test_wannier_para) diff --git a/test-suite/buildbot/farmer_intel17_impi.cfg b/test-suite/buildbot/farmer_intel17_impi.cfg index 46dc09e5de..c0b2deadd1 100644 --- a/test-suite/buildbot/farmer_intel17_impi.cfg +++ b/test-suite/buildbot/farmer_intel17_impi.cfg @@ -20,9 +20,10 @@ Environ={ 'I_MPI_SHM_LMT' : 'shm', 'MPIF90_F90' : 'ifort', 'MPICXX_CXX' : 'icpc', -'LD_LIBRARY_PATH' : '/mnt/buildbot/local/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/lib:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.4.196/linux/mpi/mic/lib:/mnt/buildbot/local/intel17/debugger_2017/iga/lib:/mnt/buildbot/local/intel17/debugger_2017/libipt/intel64/lib:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64_lin:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/lib:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/mic/lib:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/ipp/lib/intel64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64_lin:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/mkl/lib/intel64_lin:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/tbb/lib/intel64/gcc4.7:/mnt/buildbot/local/intel17/debugger_2017/iga/lib:/mnt/buildbot/local/intel17/debugger_2017/libipt/intel64/lib:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/ipp/../compiler/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/ipp/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/mkl/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/tbb/lib/intel64/cc4.1.0_libc2.4_kernel2.6.16.21:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/debugger/lib/intel64:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/mpirt/lib/intel64:/mnt/buildbot/local/intel17/impi/2017.1.132/intel64/lib:/mnt/buildbot/local/intel17/impi/2017.1.132/lib64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64_lin:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/lib:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/mic/lib:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/ipp/lib/intel64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64_lin:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/mkl/lib/intel64_lin:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/tbb/lib/intel64/gcc4.7:/mnt/buildbot/local/intel17/debugger_2017/iga/lib:/mnt/buildbot/local/intel17/debugger_2017/libipt/intel64/lib:/mnt/buildbot/local/intel17/impi/2017.1.132/lib64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017/linux/lib/intel64:/usr/local/lib64:/usr/local/lib:/mnt/buildbot/local/intel17/compilers_and_libraries_2017/linux/lib/intel64:/usr/local/lib64:/usr/local/lib', -'PATH' : '/mnt/buildbot/local/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/bin:/mnt/buildbot/local/intel17/debugger_2017/gdb/intel64_mic/bin:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/bin/intel64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/bin:/mnt/buildbot/local/intel17/debugger_2017/gdb/intel64_mic/bin:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/bin/intel64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/mnt/buildbot/local/intel12/composer_xe_2011_sp1.8.273/mpirt/bin/intel64:/mnt/buildbot/local/intel17/parallel_studio_xe_2017.4.056/bin:/mnt/buildbot/local/intel17/impi/2017.1.132/intel64/bin:/mnt/buildbot/local/intel17/impi/2017.1.132/bin64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/bin/intel64:/mnt/buildbot/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/bin:/mnt/buildbot/local/intel17/debugger_2017/gdb/intel64_mic/bin:/mnt/buildbot/local/intel17/compilers_and_libraries_2017/linux/bin/intel64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games', -'MKLROOT' : '/mnt/buildbot/local/intel17/mkl', +'LD_LIBRARY_PATH' : '/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/lib:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/mic/lib:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/compiler/lib/intel64:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/compiler/lib/intel64_lin:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/lib:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/mic/lib:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/tbb/lib/intel64_lin/gcc4.7:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/compiler/lib/intel64_lin:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mkl/lib/intel64_lin:/usr/local/lib64:/usr/local/lib', +'PATH' : '/mnt/buildbot/binary/openmpi313_intel17/bin:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/bin/intel64:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/bin:/mnt/buildbot/binary/gcc730/bin:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', +#'PATH' : '/mnt/buildbot/binary/openmpi313_intel17/bin:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/bin/intel64:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin', +'MKLROOT' : '/mnt/buildbot/binary/intel17/mkl', } Step = Steps(Environ) @@ -32,9 +33,9 @@ f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe+Step.dep_qe+Step.ma Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ Step.test_para_PW+Step.test_para_CP+Step.test_para_PH+Step.test_para_EPW) -f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ - Step.make_pw2+Step.make_lr+Step.make_sgw) #+Step.test_sgw+Step.test_clean_sgw) +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw+Step.test_sgw) -f_WAN=BuildFactory(Step.checkout_wannier+Step.cpconfig+Step.clean_wannier+Step.make_wannier+\ +f_WAN=BuildFactory(Step.checkout_wannier+Step.cpintel17i+Step.clean_wannier+Step.make_wannier+\ Step.make_wannier2+Step.test_wannier_serial+Step.test_wannier_para) diff --git a/test-suite/buildbot/farmer_intel17_mvapich23.cfg b/test-suite/buildbot/farmer_intel17_mvapich23.cfg new file mode 100644 index 0000000000..d0f130cb7c --- /dev/null +++ b/test-suite/buildbot/farmer_intel17_mvapich23.cfg @@ -0,0 +1,41 @@ +# -*- python -*- +# ex: set syntax=python: + +from slave import Steps + +Environ={ +'MPICH_F90' : 'ifort', +'CC' : 'icc', +'MPICH_CC' : 'icc', +'FC' : 'ifort', +'F90' : 'ifort', +'F77' : 'ifort', +'MPICH_F77' : 'ifort', +'CPP' : 'icc -E', +'MPICH_CPP' : 'icc -E', +'CXX' : 'icpc', +'MPICH_CCC' : 'icpc', +'MPICH_CXX' : 'icpc', +'MPICC_CC' : 'icc', +'I_MPI_SHM_LMT' : 'shm', +'MPIF90_F90' : 'ifort', +'MPICXX_CXX' : 'icpc', +'LD_LIBRARY_PATH' : '/home/local/mvapich2.3/bin:/home/local/pgi17.4/linux86-64/17.4/bin:/home/local/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/lib:/home/local/intel17/compilers_and_libraries_2017.4.196/linux/mpi/mic/lib:/home/local/intel17/debugger_2017/iga/lib:/home/local/intel17/debugger_2017/libipt/intel64/lib:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64_lin:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/lib:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/mic/lib:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/ipp/lib/intel64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64_lin:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mkl/lib/intel64_lin:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/tbb/lib/intel64/gcc4.7:/home/local/intel17/debugger_2017/iga/lib:/home/local/intel17/debugger_2017/libipt/intel64/lib:/home/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/ipp/../compiler/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/ipp/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/mkl/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/tbb/lib/intel64/cc4.1.0_libc2.4_kernel2.6.16.21:/home/local/intel12/composer_xe_2011_sp1.8.273/debugger/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/mpirt/lib/intel64:/home/local/intel17/impi/2017.1.132/intel64/lib:/home/local/intel17/impi/2017.1.132/lib64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64_lin:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/lib:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/mic/lib:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/ipp/lib/intel64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/compiler/lib/intel64_lin:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mkl/lib/intel64_lin:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/tbb/lib/intel64/gcc4.7:/home/local/intel17/debugger_2017/iga/lib:/home/local/intel17/debugger_2017/libipt/intel64/lib:/home/local/intel17/impi/2017.1.132/lib64:/home/local/intel17/compilers_and_libraries_2017/linux/lib/intel64:/usr/local/lib64:/usr/local/lib:/home/local/intel17/compilers_and_libraries_2017/linux/lib/intel64:/usr/local/lib64:/usr/local/lib', +#'PATH' : '/home/local/mvapich2.2-pgi17/bin:/home/local/pgi17.4/linux86-64/17.4/bin:/home/local/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/bin:/home/local/intel17/debugger_2017/gdb/intel64_mic/bin:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/bin/intel64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/bin:/home/local/intel17/debugger_2017/gdb/intel64_mic/bin:/home/local/intel12/composer_xe_2011_sp1.8.273/bin/intel64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/home/local/intel12/composer_xe_2011_sp1.8.273/mpirt/bin/intel64:/home/local/intel17/parallel_studio_xe_2017.4.056/bin:/home/local/intel17/impi/2017.1.132/intel64/bin:/home/local/intel17/impi/2017.1.132/bin64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/bin/intel64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/bin:/home/local/intel17/debugger_2017/gdb/intel64_mic/bin:/home/local/intel17/compilers_and_libraries_2017/linux/bin/intel64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games', +'MKLROOT' : '/home/local/intel17/mkl', +'PATH' : '/home/local/mvapich2.2-pgi17/bin:/home/local/pgi17.4/linux86-64/17.4/bin:/home/local/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/bin:/home/local/intel17/debugger_2017/gdb/intel64_mic/bin:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/bin/intel64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/bin:/home/local/intel17/debugger_2017/gdb/intel64_mic/bin:/home/local/intel12/composer_xe_2011_sp1.8.273/bin/intel64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/home/local/intel12/composer_xe_2011_sp1.8.273/mpirt/bin/intel64:/home/local/intel17/parallel_studio_xe_2017.4.056/bin:/home/local/intel17/impi/2017.1.132/intel64/bin:/home/local/intel17/impi/2017.1.132/bin64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/bin/intel64:/home/local/intel17/compilers_and_libraries_2017.1.132/linux/mpi/intel64/bin:/home/local/intel17/debugger_2017/gdb/intel64_mic/bin:/home/local/intel17/compilers_and_libraries_2017/linux/bin/intel64:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', +} + +Step = Steps(Environ) + + +f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe+Step.dep_qe+Step.make_pw+\ + Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ + Step.test_para_PW+Step.test_para_CP+Step.test_para_PH+Step.test_para_EPW) + +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw+Step.test_sgw) + +f_WAN=BuildFactory(Step.checkout_wannier+Step.cpconfig+Step.clean_wannier+Step.make_wannier+\ + Step.make_wannier2+Step.test_wannier_serial+Step.test_wannier_para) + diff --git a/test-suite/buildbot/farmer_intel17_openmpi313.cfg b/test-suite/buildbot/farmer_intel17_openmpi313.cfg new file mode 100644 index 0000000000..d1d96caaa1 --- /dev/null +++ b/test-suite/buildbot/farmer_intel17_openmpi313.cfg @@ -0,0 +1,41 @@ +# -*- python -*- +# ex: set syntax=python: + +from slave import Steps + +Environ={ +'MPICH_F90' : 'ifort', +'CC' : 'icc', +'MPICH_CC' : 'icc', +'FC' : 'ifort', +'F90' : 'ifort', +'F77' : 'ifort', +'MPICH_F77' : 'ifort', +'CPP' : 'icc -E', +'MPICH_CPP' : 'icc -E', +'CXX' : 'icpc', +'MPICH_CCC' : 'icpc', +'MPICH_CXX' : 'icpc', +'MPICC_CC' : 'icc', +'I_MPI_SHM_LMT' : 'shm', +'MPIF90_F90' : 'ifort', +'MPICXX_CXX' : 'icpc', +'LD_LIBRARY_PATH' : '/mnt/buildbot/binary/openmpi313_intel17/lib:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/compiler/lib/intel64:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/compiler/lib/intel64_lin:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/lib:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/mic/lib:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/tbb/lib/intel64_lin/gcc4.7:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/compiler/lib/intel64_lin:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mkl/lib/intel64_lin:/usr/local/lib64:/usr/local/lib', +#'PATH' : '/mnt/buildbot/binary/openmpi313_intel17/bin:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/bin/intel64:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin', +'PATH' : '/mnt/buildbot/binary/openmpi313_intel17/bin:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/bin/intel64:/mnt/buildbot/binary/intel17/compilers_and_libraries_2017.4.196/linux/mpi/intel64/bin:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', +'MKLROOT' : '/mnt/buildbot/binary/intel17/mkl', +} + +Step = Steps(Environ) + + +f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe+Step.dep_qe+Step.make_pw+\ + Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ + Step.test_para_PW+Step.test_para_CP+Step.test_para_PH+Step.test_para_EPW) + +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw+Step.test_sgw) + +f_WAN=BuildFactory(Step.checkout_wannier+Step.cpintel17+Step.clean_wannier+Step.make_wannier+\ + Step.make_wannier2+Step.test_wannier_serial+Step.test_wannier_para) + diff --git a/test-suite/buildbot/farmer_intel18_mvapich23.cfg b/test-suite/buildbot/farmer_intel18_mvapich23.cfg new file mode 100644 index 0000000000..6075e659cd --- /dev/null +++ b/test-suite/buildbot/farmer_intel18_mvapich23.cfg @@ -0,0 +1,41 @@ +# -*- python -*- +# ex: set syntax=python: + +from slave import Steps + +Environ={ +'MPICH_F90' : 'ifort', +'CC' : 'icc', +'MPICH_CC' : 'icc', +'FC' : 'ifort', +'F90' : 'ifort', +'F77' : 'ifort', +'MPICH_F77' : 'ifort', +'CPP' : 'icc -E', +'MPICH_CPP' : 'icc -E', +'CXX' : 'icpc', +'MPICH_CCC' : 'icpc', +'MPICH_CXX' : 'icpc', +'MPICC_CC' : 'icc', +'I_MPI_SHM_LMT' : 'shm', +'MPIF90_F90' : 'ifort', +'MPICXX_CXX' : 'icpc', +'LD_LIBRARY_PATH' : '/home/local/mvapich23_intel18/lib:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/lib:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/mic/lib:/home/local/intel18_plus_impi/debugger_2018/iga/lib:/home/local/intel18_plus_impi/debugger_2018/libipt/intel64/lib:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64_lin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/lib:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/mic/lib:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/ipp/lib/intel64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64_lin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mkl/lib/intel64_lin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/tbb/lib/intel64/gcc4.7:/home/local/intel18_plus_impi/debugger_2018/iga/lib:/home/local/intel18_plus_impi/debugger_2018/libipt/intel64/lib:/home/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/ipp/../compiler/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/ipp/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/compiler/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/mkl/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/tbb/lib/intel64/cc4.1.0_libc2.4_kernel2.6.16.21:/home/local/intel12/composer_xe_2011_sp1.8.273/debugger/lib/intel64:/home/local/intel12/composer_xe_2011_sp1.8.273/mpirt/lib/intel64:/home/local/intel18_plus_impi/impi/2017.1.132/intel64/lib:/home/local/intel18_plus_impi/impi/2017.1.132/lib64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64_lin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/lib:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/mic/lib:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/ipp/lib/intel64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64_lin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mkl/lib/intel64_lin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/tbb/lib/intel64/gcc4.7:/home/local/intel18_plus_impi/debugger_2018/iga/lib:/home/local/intel18_plus_impi/debugger_2018/libipt/intel64/lib:/home/local/intel18_plus_impi/impi/2017.1.132/lib64:/home/local/intel18_plus_impi/compilers_and_libraries_2017/linux/lib/intel64:/usr/local/lib64:/usr/local/lib:/home/local/intel18_plus_impi/compilers_and_libraries_2017/linux/lib/intel64:/usr/local/lib64:/usr/local/lib', +#'PATH' : '/home/local/mvapich23_intel18/bin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/home/local/intel18_plus_impi/debugger_2018/gdb/intel64_mic/bin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/bin/intel64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/home/local/intel18_plus_impi/debugger_2018/gdb/intel64_mic/bin:/home/local/intel12/composer_xe_2011_sp1.8.273/bin/intel64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/home/local/intel12/composer_xe_2011_sp1.8.273/mpirt/bin/intel64:/home/local/intel18_plus_impi/parallel_studio_xe_2017.4.056/bin:/home/local/intel18_plus_impi/impi/2017.1.132/intel64/bin:/home/local/intel18_plus_impi/impi/2017.1.132/bin64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/bin/intel64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/home/local/intel18_plus_impi/debugger_2018/gdb/intel64_mic/bin:/home/local/intel18_plus_impi/compilers_and_libraries_2017/linux/bin/intel64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games', +'PATH' : '/home/local/mvapich23_intel18/bin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/home/local/intel18_plus_impi/debugger_2018/gdb/intel64_mic/bin:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/bin/intel64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/home/local/intel18_plus_impi/debugger_2018/gdb/intel64_mic/bin:/home/local/intel12/composer_xe_2011_sp1.8.273/bin/intel64:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/home/local/intel12/composer_xe_2011_sp1.8.273/mpirt/bin/intel64:/home/local/intel18_plus_impi/parallel_studio_xe_2017.4.056/bin:/home/local/intel18_plus_impi/impi/2017.1.132/intel64/bin:/home/local/intel18_plus_impi/impi/2017.1.132/bin64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/bin/intel64:/home/local/intel18_plus_impi/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/home/local/intel18_plus_impi/debugger_2018/gdb/intel64_mic/bin:/home/local/intel18_plus_impi/compilers_and_libraries_2017/linux/bin/intel64:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', +'MKLROOT' : '/home/local/intel18_plus_impi/mkl', +} + +Step = Steps(Environ) + + +f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe+Step.dep_qe+Step.make_pw+\ + Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ + Step.test_para_PW+Step.test_para_CP+Step.test_para_PH+Step.test_para_EPW) + +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw+Step.test_sgw) + +f_WAN=BuildFactory(Step.checkout_wannier+Step.cpconfig+Step.clean_wannier+Step.make_wannier+\ + Step.make_wannier2+Step.test_wannier_serial+Step.test_wannier_para) + diff --git a/test-suite/buildbot/farmer_intel18_openmpi313.cfg b/test-suite/buildbot/farmer_intel18_openmpi313.cfg new file mode 100644 index 0000000000..7585276a9e --- /dev/null +++ b/test-suite/buildbot/farmer_intel18_openmpi313.cfg @@ -0,0 +1,41 @@ +# -*- python -*- +# ex: set syntax=python: + +from slave import Steps + +Environ={ +'MPICH_F90' : 'ifort', +'CC' : 'icc', +'MPICH_CC' : 'icc', +'FC' : 'ifort', +'F90' : 'ifort', +'F77' : 'ifort', +'MPICH_F77' : 'ifort', +'CPP' : 'icc -E', +'MPICH_CPP' : 'icc -E', +'CXX' : 'icpc', +'MPICH_CCC' : 'icpc', +'MPICH_CXX' : 'icpc', +'MPICC_CC' : 'icc', +'I_MPI_SHM_LMT' : 'shm', +'MPIF90_F90' : 'ifort', +'MPICXX_CXX' : 'icpc', +'LD_LIBRARY_PATH' : '/mnt/buildbot/binary/openmpi313_intel18/lib:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64_lin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mpi/intel64/lib:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mpi/mic/lib:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64_lin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mkl/lib/intel64_lin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/tbb/lib/intel64/gcc4.7:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/tbb/lib/intel64/gcc4.7', +#'PATH' : '/mnt/buildbot/binary/openmpi313_intel18/bin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/bin/intel64:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin', +'PATH' : '/mnt/buildbot/binary/openmpi313_intel18/bin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/bin/intel64:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', +'MKLROOT' : '/mnt/buildbot/binary/intel18/mkl', +} + +Step = Steps(Environ) + + +f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe+Step.dep_qe+Step.make_pw+\ + Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ + Step.test_para_PW+Step.test_para_CP+Step.test_para_PH+Step.test_para_EPW) + +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw+Step.test_sgw) + +f_WAN=BuildFactory(Step.checkout_wannier+Step.cpintel18+Step.clean_wannier+Step.make_wannier+\ + Step.make_wannier2+Step.clean_tests+Step.test_wannier_serial+Step.test_wannier_para) + diff --git a/test-suite/buildbot/farmer_intel18_openmpi313_openmp.cfg b/test-suite/buildbot/farmer_intel18_openmpi313_openmp.cfg new file mode 100644 index 0000000000..ba2a79f91e --- /dev/null +++ b/test-suite/buildbot/farmer_intel18_openmpi313_openmp.cfg @@ -0,0 +1,41 @@ +# -*- python -*- +# ex: set syntax=python: + +from slave import Steps + +Environ={ +'MPICH_F90' : 'ifort', +'CC' : 'icc', +'MPICH_CC' : 'icc', +'FC' : 'ifort', +'F90' : 'ifort', +'F77' : 'ifort', +'MPICH_F77' : 'ifort', +'CPP' : 'icc -E', +'MPICH_CPP' : 'icc -E', +'CXX' : 'icpc', +'MPICH_CCC' : 'icpc', +'MPICH_CXX' : 'icpc', +'MPICC_CC' : 'icc', +'I_MPI_SHM_LMT' : 'shm', +'MPIF90_F90' : 'ifort', +'MPICXX_CXX' : 'icpc', +'LD_LIBRARY_PATH' : '/mnt/buildbot/binary/openmpi313_intel18/lib:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64_lin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mpi/intel64/lib:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mpi/mic/lib:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/compiler/lib/intel64_lin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mkl/lib/intel64_lin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/tbb/lib/intel64/gcc4.7:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/tbb/lib/intel64/gcc4.7', +#'PATH' : '/mnt/buildbot/binary/openmpi313_intel18/bin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/bin/intel64:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin', +'PATH' : '/mnt/buildbot/binary/openmpi313_intel18/bin:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/bin/intel64:/mnt/buildbot/binary/intel18/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin:/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', +'MKLROOT' : '/mnt/buildbot/binary/intel18/mkl', +} + +Step = Steps(Environ) + + +f=BuildFactory(Step.clean+Step.checkout_qe+Step.env_qe1+Step.env_qe2+Step.configure_qe_mp+Step.dep_qe+Step.make_pw+\ + Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ + Step.test_para_PW+Step.test_para_PH+Step.test_para_EPW) + +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw+Step.test_sgw) + +#f_WAN=BuildFactory(Step.checkout_wannier+Step.cpintel18+Step.clean_wannier+Step.make_wannier+\ +# Step.make_wannier2+Step.clean_tests+Step.test_wannier_serial+Step.test_wannier_para) + diff --git a/test-suite/buildbot/farmer_pgi18_mvapich23b.cfg b/test-suite/buildbot/farmer_pgi18_mvapich23b.cfg new file mode 100644 index 0000000000..e5f6c697c4 --- /dev/null +++ b/test-suite/buildbot/farmer_pgi18_mvapich23b.cfg @@ -0,0 +1,30 @@ +# -*- python -*- +# ex: set syntax=python: + +from slave import Steps + +Environ={ +'MV2_SMP_USE_CMA' : '0', +'CC' : 'pgcc', +'CXX' : 'pgc++', +'F77' : 'pgf77', +'F90' : 'pgf90', +'FC' : 'pgfortran', +'LM_LICENSE_FILE' : '8000@licserverhpc.cineca.it', +'LD_LIBRARY_PATH' : '/mnt/buildbot/binary/mvapich23_pgi185/lib:/mnt/buildbot/binary/pgi185/linux86-64/18.5/lib:/usr/local/lib64:/usr/local/lib', +#'PATH' : '/mnt/buildbot/binary/mvapich23_pgi185/bin:/mnt/buildbot/binary/pgi185/linux86-64/18.5/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games', +'PATH' : '/mnt/buildbot/binary/mvapich23_pgi185/bin:/mnt/buildbot/binary/pgi185/linux86-64/18.5/bin::/home/buildbot2/bin:/home/buildbot2/.local/bin:/home/buildbot2/sandbox/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games:/snap/bin', +} + +Step = Steps(Environ) + + +f=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe+Step.dep_qe+Step.make_pw+\ + Step.make_ph+Step.make_epw0+Step.make_epw+Step.test_clean+Step.test0+\ + Step.test_para_PW+Step.test_para_CP+Step.test_para_PH+Step.test_para_EPW) + +#f_SGW=BuildFactory(Step.clean+Step.checkout_qe+Step.configure_qe2+Step.dep_qe+Step.checkout_sgw+\ +# Step.make_pw2+Step.make_lr+Step.make_clean+Step.make_sgw) #+Step.test_sgw) + +f_WAN=BuildFactory(Step.checkout_wannier+Step.cppgi18+Step.clean_wannier+Step.make_wannier+\ + Step.make_wannier2+Step.clean_tests+Step.test_wannier_serial+Step.clean_tests+Step.test_wannier_para) diff --git a/test-suite/buildbot/master.cfg b/test-suite/buildbot/master.cfg index 5fd1f77642..21ba48deee 100644 --- a/test-suite/buildbot/master.cfg +++ b/test-suite/buildbot/master.cfg @@ -1,8 +1,8 @@ -# -# 2016-2018 : Samuel Ponce' and Martin Schlipf -# -# This is the CINECA buildmaster config file. It must be installed as -# 'master.cfg' in the buildmaster's base directory. +# -*- python -*- +# ex: set syntax=python: + +# This is a sample buildmaster config file. It must be installed as +# 'master.cfg' in your buildmaster's base directory. import re, time import itertools @@ -11,19 +11,41 @@ import itertools # a shorter alias to save typing. c = BuildmasterConfig = {} +#SP epw http://qeforge.qe-forge.org/svn/epw/branches/sponce/epw +#SP qe http://qeforge.qe-forge.org/svn/q-e/trunk/espresso +#source_root = 'http://qeforge.qe-forge.org/svn/' +#source_user = 'qe-anonymous' qe_project = 'https://gitlab.com/QEF/q-e.git' projects = ['https://gitlab.com/QEF/q-e.git'] +#all_repos = { +# 'quantum_espresso': { +# 'repository': 'https://github.com/QEF/q-e.git', +# 'branch': 'master', +# }, +# 'sternheimer_gw': { +# 'repository': 'mml_farm@maroon.materials.ox.ac.uk:~/SGW/', +# 'branch': 'develop', +# }, +# 'wannier90': { +# 'repository': 'https://github.com/wannier-developers/wannier90.git', +# 'branch': 'develop', +# }, +#} + passwd = { 'source': '', - 'farmer-slave2': 'XXXXXXXXXXXXXXXXX', + 'farmer-slave1': 'XXXXXXX', } from buildbot.locks import MasterLock source_lock = MasterLock('source') -slave_builders = { "farmer-slave2": ["farmer_gcc640_serial","farmer_gcc640_para",\ - "farmer_intel17_impi","farmer_pgi17_mvapich23b","farmer_intel12_openmpi"]} +#slave_builders = { "farmer-slave1": ["farmer_gcc730_openmpi1107","farmer_pgi18_mvapich23b",\ +# "farmer_intel18_impi","farmer_intel18_mvapich23", "farmer_gcc650_serial"]} +slave_builders = { "farmer-slave1": ["farmer_gcc640_serial","farmer_gcc730_openmpi1107","farmer_intel18_openmpi313",\ + "farmer_pgi18_mvapich23b","farmer_intel17_openmpi313","farmer_intel17_impi",\ + "farmer_intel18_openmpi313_openmp"]} slaves = slave_builders.keys() builders = list( itertools.chain.from_iterable( slave_builders.values() ) ) @@ -37,15 +59,20 @@ def getslavebybuilders(b): return None builder_epw = [] -builder_sgw = [] +#builder_sgw = [] builder_wan = [] +#builder_test = [] for v in builders: builder_epw.extend(["%s-%s" % ('QE', v)]) - builder_sgw.extend(["%s-%s" % ('SGW', v)]) +# if v != "farmer_gcc640_serial": +# builder_sgw.extend(["%s-%s" % ('SGW', v)]) builder_wan.extend(["%s-%s" % ('WAN', v)]) +# builder_test.extend(["%s-%s" % ('test', v)]) -builder_qe = builder_epw + builder_sgw -builder_all = builder_epw + builder_sgw + builder_wan #+ builder_test +#builder_qe = builder_epw + builder_sgw +#builder_all = builder_epw + builder_sgw + builder_wan #+ builder_test +builder_qe = builder_epw +builder_all = builder_epw + builder_wan #+ builder_test ####### BUILDSLAVES @@ -54,7 +81,8 @@ builder_all = builder_epw + builder_sgw + builder_wan #+ builder_test # slave name and password must be configured on the slave. from buildbot.buildslave import BuildSlave c['slaves'] = [ - BuildSlave('farmer-slave2', passwd['farmer-slave2'],max_builds=1, keepalive_interval=120), + BuildSlave('farmer-slave1', passwd['farmer-slave1'],max_builds=1, keepalive_interval=120), + #BuildSlave('farmer-slave1', passwd['farmer-slave1'],max_builds=2, keepalive_interval=120), ] # 'slavePortnum' defines the TCP port to listen on for connections from slaves. @@ -73,19 +101,20 @@ c['change_source'] = [] c['change_source'].extend([ GitPoller( project='quantum_espresso', +# repourl='https://github.com/QEF/q-e.git', repourl='https://gitlab.com/QEF/q-e.git', branches=['develop'], workdir='gitpoller_QE', category='qe_update', )])# for i, name in enumerate(projects)) -c['change_source'].extend([ - GitPoller( - project='sternheimer_gw', - repourl='https://github.com/mmdg-oxford/SternheimerGW.git', - branches=['develop'], - workdir='gitpoller_SGW', - category='sgw_update', - )]) +#c['change_source'].extend([ +# GitPoller( +# project='sternheimer_gw', +# repourl='https://github.com/mmdg-oxford/SternheimerGW.git', +# branches=['develop'], +# workdir='gitpoller_SGW', +# category='sgw_update', +# )]) c['change_source'].extend([ GitPoller( project='wannier90', @@ -114,6 +143,7 @@ c['schedulers'].extend([ category = 'qe_update', branch = ['develop'], ), + #branch = 'master', onlyIfChanged = True, hour = 2, minute = 0, @@ -121,21 +151,23 @@ c['schedulers'].extend([ createAbsoluteSourceStamps = True, ) ]) -c['schedulers'].extend([ - Nightly( - name = 'SGW' + '-nightly', - change_filter=ChangeFilter( - project = 'sternheimer_gw', - category = 'sgw_update', - branch = ['develop'], - ), - onlyIfChanged = True, - hour = 2, - minute = 0, - builderNames=builder_sgw, - createAbsoluteSourceStamps = True, - ) -]) +# SP: Disabled for now - do not remove +#c['schedulers'].extend([ +# Nightly( +# name = 'SGW' + '-nightly', +# change_filter=ChangeFilter( +# project = 'sternheimer_gw', +# category = 'sgw_update', +# branch = ['develop'], +# ), +# #branch = 'master', +# onlyIfChanged = True, +# hour = 1, +# minute = 0, +# builderNames=builder_sgw, +# createAbsoluteSourceStamps = True, +# ) +#]) c['schedulers'].extend([ Nightly( name = 'WAN' + '-nightly', @@ -181,6 +213,71 @@ c['schedulers'].extend([ ], )]) +#From buildbot.schedulers.forcesched import ForceScheduler +#From buildbot.plugins import util +#C['schedulers'].extend([ +# ForceScheduler( +# name='force build', +# builderNames=builder_all, +# CodeBase(name='branch') #, +# # choices=["master","stable_release","release"], default="master"), +# branch=util.ChoiceStringParameter(name="branch", +# choices=["master","stable_release","release"], default="master"), +# ) +# for name in projects +#]) + +#from buildbot.plugins import schedulers, util + +#sch = schedulers.ForceScheduler( +# name="force", +# buttonName="pushMe!", +# label="QEF build request form", +# builderNames=["builder_qe"], +# +# codebases=[ +# util.CodebaseParameter( +# "", +# name="Main repository", +# # will generate a combo box +# branch=util.ChoiceStringParameter( +# name="branch", +# choices=["master", "devel"], +# default="master"), +# +# # will generate nothing in the form, but revision, repository, +# # and project are needed by buildbot scheduling system so we +# # need to pass a value ("") +# revision=util.FixedParameter(name="revision", default=""), +# repository=util.FixedParameter(name="repository", default=""), +# project=util.FixedParameter(name="project", default=""), +# ), +# ], +# # will generate a text input +# reason=util.StringParameter(name="reason", +# label="reason:", +# required=True, size=80), +# +# # in case you don't require authentication this will display +# # input for user to type his name +# username=util.UserNameParameter(label="your name:", +# size=80), +# # A completely customized property list. The name of the +# # property is the name of the parameter +# properties=[ +# util.NestedParameter(name="options", label="Build Options", layout="vertical", fields=[ +# util.StringParameter(name="pull_url", +# label="optionally give a public Git pull url:", +# default="", size=80), +# util.BooleanParameter(name="force_build_clean", +# label="force a make clean", +# default=False) +# ]) +# ]) +# +#c['schedulers'].extend(sch) + + ####### BUILDERS # The 'builders' list defines the Builders, which tell Buildbot how to perform a build: @@ -188,6 +285,7 @@ c['schedulers'].extend([ # only take place on one slave. from buildbot.config import BuilderConfig +#from buildbot.steps.source import Git from buildbot.plugins import steps from buildbot.process.factory import BuildFactory from buildbot.steps.shell import ShellCommand @@ -206,16 +304,17 @@ for name in projects: factory=f, ) ) - for BuilderID in builders: - with open( '%s.cfg' % BuilderID ) as fn: - exec fn - c['builders'].append( - BuilderConfig( - name= '%s-%s' % ('SGW',BuilderID), - slavename=getslavebybuilders(BuilderID), - factory=f_SGW, - ) - ) +# for BuilderID in builders: +# if BuilderID != "farmer_gcc640_serial": +# with open( '%s.cfg' % BuilderID ) as fn: +# exec fn +# c['builders'].append( +# BuilderConfig( +# name= '%s-%s' % ('SGW',BuilderID), +# slavename=getslavebybuilders(BuilderID), +# factory=f_SGW, +# ) +# ) for BuilderID in builders: with open( '%s.cfg' % BuilderID ) as fn: exec fn @@ -232,6 +331,32 @@ for name in projects: ####### STATUS TARGETS + +# 'status' is a list of Status Targets. The results of each build will be +# pushed to these targets. buildbot/status/*.py has a variety to choose from, +# including web pages, email senders, and IRC bots. + +# Old version + +#c['status'] = [] +#from buildbot.status import html +#from buildbot.status.web import authz, auth + +#authz_cfg=authz.Authz( +# # change any of these to True to enable; see the manual for more +# # options +# auth=auth.BasicAuth([("admin","mml21br")]), +# gracefulShutdown = 'auth', +# forceBuild = 'auth', # use this to test your slave once it is set up +# forceAllBuilds = 'auth', +# pingBuilder = 'auth', +# stopBuild = 'auth', +# stopAllBuilds = 'auth', +# cancelPendingBuild = 'auth', +#) + +#c['status'].append(html.WebStatus(http_port=8010, authz=authz_cfg)) + # New version from buildbot.plugins import util @@ -241,6 +366,36 @@ c['www'] = dict(port=8010, console_view={}), auth=util.UserPasswordAuth({"admin": "qeffarm"}) ) +###### SEND EMAIL if FAIL #### +# server = SMTP(SMTP_HOST) +# +## server.ehlo() +## print(server.ehlo()) +# +# server.starttls() +# +# print(server.ehlo(LOCAL_HOST)) +# +# user = raw_input('user: ') +# password = getpass('password: ') +# +# print(server.login(user, password)) +# +# fromaddr = 'testfarmqef@gmail.com' +# toaddrs = 'samuel.pon@gmail.com' +# msg = "\r\n".join([ +# "From: testfarmqef@gmail.com", +# "To: samuel.pon@gmail.com", +# "Subject: Buildbot", +# "", +# "Why, oh why" +# ]) +# +# +# server.sendmail(fromaddr, toaddrs, msg) +# server.close() +# + email = ['samuel.pon@gmail.com','martin.schlipf@gmail.com','p.giannozzi@gmail.com',\ 'degironc@sissa.it','baroni@sissa.it','feliciano.giustino@materials.ox.ac.uk',\ 'pdelugas@sissa.it','p.bonfa@cineca.it','andrea.ferretti@nano.cnr.it',\ @@ -260,6 +415,7 @@ mn = reporters.MailNotifier(fromaddr="testfarmqef@gmail.com", useSmtps=True, smtpPort=465, builders=builder_epw, + #useTls=True, subject='Test-farm failing', smtpPassword="QEFtestfarm") c['services'].append(mn) @@ -279,7 +435,7 @@ c['titleURL'] = "http://foundation.quantum-espresso.org/" # with an externally-visible host name which the buildbot cannot figure out # without some help. -c['buildbotURL'] = "http://130.186.13.198:8010/" +c['buildbotURL'] = "http://130.186.13.169:8010/" ####### DB URL diff --git a/test-suite/buildbot/slave.py b/test-suite/buildbot/slave.py index d7bd33c261..01ea845ea2 100644 --- a/test-suite/buildbot/slave.py +++ b/test-suite/buildbot/slave.py @@ -1,21 +1,17 @@ -# -# 2016-2018 : Samuel Ponce' and Martin Schlipf -# -# Setup used by the different Buildbot slaves. -# - from buildbot.plugins import steps from buildbot.steps.shell import ShellCommand from buildbot.locks import SlaveLock +from buildbot.process.properties import Interpolate + class Steps: def __init__(self,Environ): # Max number of running builds build_lock = SlaveLock('build', - maxCount = 1, + maxCount = 2, maxCountForSlave = { - 'farmer-slave1': 1, + 'farmer-slave1': 2, }) # All repo @@ -24,12 +20,13 @@ def __init__(self,Environ): 'repository': 'https://gitlab.com/QEF/q-e.git', 'branch': 'develop', }, - 'sternheimer_gw': { - 'repository': 'https://github.com/mmdg-oxford/SternheimerGW.git', - 'branch': 'develop', - }, +# 'sternheimer_gw': { +# 'repository': 'https://github.com/mmdg-oxford/SternheimerGW.git', +# 'branch': 'develop', +# }, 'wannier90': { 'repository': 'https://github.com/wannier-developers/wannier90.git', +# 'repository': 'https://github.com/sponce24/wannier90.git', 'branch': 'develop', }, } @@ -55,6 +52,15 @@ def __init__(self,Environ): locks=[build_lock.access('counting')], haltOnFailure = True,descriptionDone=["configure_qe"] )] + + self.configure_qe_mp = [ShellCommand( + name="configure_qe", + command=["./configure","--enable-openmp","--enable-parallel"], + env=Environ, + workdir="build", + locks=[build_lock.access('counting')], + haltOnFailure = True,descriptionDone=["configure_qe_mp"] + )] self.dep_qe = [ShellCommand( name="dep_qe", @@ -66,10 +72,31 @@ def __init__(self,Environ): locks=[build_lock.access('counting')], haltOnFailure = True,descriptionDone=["dep_qe"] )] + + self.env_qe1 = [ShellCommand( + name="env_qe1", + command=Interpolate('sed -i "s/TESTCODE_NPROCS=4/TESTCODE_NPROCS=2/g" ENVIRONMENT'), + env=Environ, + workdir="build/test-suite/", + locks=[build_lock.access('counting')], + haltOnFailure = True, + descriptionDone=["env_qe1"] + )] + + self.env_qe2 = [ShellCommand( + name="env_qe2", + command=Interpolate('echo "export OMP_NUM_THREADS=2" >> ENVIRONMENT'), + #command=["cat","'export OMP_NUM_THREADS=2'",">>", "ENVIRONMENT"], + env=Environ, + workdir="build/test-suite/", + locks=[build_lock.access('counting')], + haltOnFailure = True,descriptionDone=["env_qe2"] + )] + self.make_pw = [ShellCommand( name="make_pw", - command=["make","pwall","cp","ld1","upf"], + command=["make","-j","4","pwall","cp","ld1","upf"], env=Environ, workdir="build", haltOnFailure=True, descriptionDone=["make_pw"], @@ -212,61 +239,71 @@ def __init__(self,Environ): ############################################################################ # SGW code ############################################################################ - self.configure_qe2 = [ShellCommand( - name="configure_qe", - command=["./configure"], - env=Environ, - workdir="build", - locks=[build_lock.access('counting')], - haltOnFailure = True,descriptionDone=["configure_qe"] - )] - - self.make_pw2 = [ShellCommand( - name="make_pw", - command=["make","pw","lrmods"], - env=Environ, - workdir="build", - haltOnFailure=True, descriptionDone=["make_pw"], - locks=[build_lock.access('counting')] - )] - - self.checkout_sgw = [steps.Git( - name="checkout_sgw", - repourl=all_repos["sternheimer_gw"]["repository"], - branch=all_repos["sternheimer_gw"]["branch"], - workdir="build/SGW", - haltOnFailure = True, - alwaysUseLatest = True, - )] - - self.make_sgw = [ShellCommand( - name="make_sgw", - command=["make"], - env=Environ, - workdir="build/SGW", - haltOnFailure = True, - descriptionDone = ["make_sgw"], - locks=[build_lock.access('counting')], - )] - - self.test_sgw = [ShellCommand( - name="test_sgw", - command=["make", "run-tests"], - env=Environ, - workdir="build/SGW/test-suite", - haltOnFailure = True, - descriptionDone = ["test_sgw"], - locks=[build_lock.access('counting')], - )] - - self.test_clean_sgw = [ShellCommand( - name="test_clean", - command=["make", "clean"], - env=Environ, - workdir="build/SGW/test-suite", - descriptionDone = ["test_clean"], - locks=[build_lock.access('counting')], - )] +# self.configure_qe2 = [ShellCommand( +# name="configure_qe", +# command=["./configure"], +# env=Environ, +# workdir="build", +# locks=[build_lock.access('counting')], +# haltOnFailure = True,descriptionDone=["configure_qe"] +# )] +# +# self.make_pw2 = [ShellCommand( +# name="make_pw", +# command=["make","pw","lrmods"], +# env=Environ, +# workdir="build", +# haltOnFailure=True, descriptionDone=["make_pw"], +# locks=[build_lock.access('counting')] +# )] +# +# self.checkout_sgw = [steps.Git( +# name="checkout_sgw", +# repourl=all_repos["sternheimer_gw"]["repository"], +# branch=all_repos["sternheimer_gw"]["branch"], +# workdir="build/SGW", +# haltOnFailure = True, +# alwaysUseLatest = True, +# )] +# +# self.make_clean = [ShellCommand( +# name="make_clean", +# command=["make", "clean"], +# env=Environ, +# workdir="build/SGW", +# haltOnFailure = True, +# descriptionDone = ["make_clean"], +# locks=[build_lock.access('counting')], +# )] +# +# self.make_sgw = [ShellCommand( +# name="make_sgw", +# command=["make"], +# env=Environ, +# workdir="build/SGW", +# haltOnFailure = True, +# descriptionDone = ["make_sgw"], +# locks=[build_lock.access('counting')], +# )] +# +# self.test_sgw = [ShellCommand( +# name="test_sgw", +# command=["make", "run-tests"], +# env=Environ, +# workdir="build/SGW/test-suite", +# haltOnFailure = True, +# descriptionDone = ["test_sgw"], +# locks=[build_lock.access('counting')], +# )] +# +# self.test_clean_sgw = [ShellCommand( +# name="test_clean", +# command=["make", "clean"], +# env=Environ, +# workdir="build/SGW/test-suite", +# descriptionDone = ["test_clean"], +# locks=[build_lock.access('counting')], +# )] ############################################################################ @@ -285,7 +322,52 @@ def __init__(self,Environ): self.cpconfig = [ShellCommand( name="cp_config", - command=["cp","test-suite/config/EPW_testfarm/farmer_gcc485.inc","make.inc"], + command=["cp","test-suite/config/TestFarm/farmer_gcc640_serial.inc","make.inc"], + env=Environ, + workdir="build/WAN", + haltOnFailure=True, descriptionDone=["cp_config"], + locks=[build_lock.access('counting')] + )] + + self.cpgcc730 = [ShellCommand( + name="cp_config", + command=["cp","test-suite/config/TestFarm/farmer_gcc730_openmpi1107.inc","make.inc"], + env=Environ, + workdir="build/WAN", + haltOnFailure=True, descriptionDone=["cp_config"], + locks=[build_lock.access('counting')] + )] + + self.cpintel17 = [ShellCommand( + name="cp_config", + command=["cp","test-suite/config/TestFarm/farmer_intel17_openmpi313.inc","make.inc"], + env=Environ, + workdir="build/WAN", + haltOnFailure=True, descriptionDone=["cp_config"], + locks=[build_lock.access('counting')] + )] + + self.cpintel17i = [ShellCommand( + name="cp_config", + command=["cp","test-suite/config/TestFarm/farmer_intel17_impi.inc","make.inc"], + env=Environ, + workdir="build/WAN", + haltOnFailure=True, descriptionDone=["cp_config"], + locks=[build_lock.access('counting')] + )] + + self.cpintel18 = [ShellCommand( + name="cp_config", + command=["cp","test-suite/config/TestFarm/farmer_intel18_openmpi313.inc","make.inc"], + env=Environ, + workdir="build/WAN", + haltOnFailure=True, descriptionDone=["cp_config"], + locks=[build_lock.access('counting')] + )] + + self.cppgi18 = [ShellCommand( + name="cp_config", + command=["cp","test-suite/config/TestFarm/farmer_pgi18_mvapich23b.inc","make.inc"], env=Environ, workdir="build/WAN", haltOnFailure=True, descriptionDone=["cp_config"], @@ -294,11 +376,21 @@ def __init__(self,Environ): self.clean_wannier = [ShellCommand( name="clean_wannier", + command=["make","clean"], + env=Environ, + workdir="build/WAN", + haltOnFailure = True, + descriptionDone = ["clean_wannier"], + locks=[build_lock.access('counting')], + )] + + self.clean_tests = [ShellCommand( + name="clean_tests", command=["python","clean_tests"], env=Environ, workdir="build/WAN/test-suite", haltOnFailure = True, - descriptionDone = ["clean_wannier"], + descriptionDone = ["clean_tests"], locks=[build_lock.access('counting')], )] diff --git a/test-suite/userconfig.tmp b/test-suite/userconfig.tmp index 5f3525adcc..007379099e 100644 --- a/test-suite/userconfig.tmp +++ b/test-suite/userconfig.tmp @@ -56,8 +56,8 @@ run_cmd_template = tc.program tc.args tc.input tc.output tc.error tolerance = ( (1.0e-6, 5.0e-3, 'e1'), (4.0e+0, 5.0e-1, 'n1'), (1.0e-3, 1.0e-5, 'f1'), - (1.0e-1, 1.0e-3, 'p1'), - (1.0e-2, 1.0e-5, 'ef1'), + (1.0e-1, 5.0e-3, 'p1'), + (1.0e-2, 1.0e-4, 'ef1'), (1.0e-2, 2.0e-4, 'eh1'), (1.0e-2, 2.0e-4, 'ehl1'), (1.0e-2, 1.0e-5, 'tf1'), @@ -83,8 +83,8 @@ tolerance = ( (1.0e-6, 5.0e-3, 'e1'), (2.0e-5, 6.0e-3, 'logavg'), (1.0e-2, 9.9e-3, 'l_a2F'), (1.0e-5, 1.0e-5, 'efm'), - (5.0e-2, 1.0e-3, 'lam_max'), - (5.0e-4, 5.0e-4, 'lam_kmax'), + (8.0e-2, 1.0e-3, 'lam_max'), + (5.0e-3, 1.0e-3, 'lam_kmax'), (5.0e-4, 5.0e-4, 'elph'), (2.0e-2, 5.0e-4, 'allDyn'), (2.0e-3, 5.0e-4, 'pi'), From b385f6dbe038bc2d1b08c2e7ce211957f19a2c50 Mon Sep 17 00:00:00 2001 From: Pietro Date: Mon, 22 Jul 2019 06:26:08 +0000 Subject: [PATCH 83/95] Variable "psi_rhoc_work" was not deallocated. --- PW/src/exx.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/PW/src/exx.f90 b/PW/src/exx.f90 index 83de3a6ee2..f640afb7f0 100644 --- a/PW/src/exx.f90 +++ b/PW/src/exx.f90 @@ -1157,6 +1157,7 @@ SUBROUTINE vexx_gamma(lda, n, m, psi, hpsi, becpsi) ! DEALLOCATE(big_result) DEALLOCATE( result, temppsic_dble, temppsic_aimag) + DEALLOCATE( psi_rhoc_work ) DEALLOCATE( vc, fac ) IF(okvan) DEALLOCATE( deexx ) ! From a2672add31f4b2d6c1ef87f6f2095c46700e3960 Mon Sep 17 00:00:00 2001 From: Nick Forrington Date: Tue, 23 Jul 2019 11:09:44 -0400 Subject: [PATCH 84/95] HP: Fix type mismatch errors --- HP/src/hp_calc_chi.f90 | 2 +- HP/src/hp_write_chi.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/HP/src/hp_calc_chi.f90 b/HP/src/hp_calc_chi.f90 index 0526f0ff1d..03760f88c4 100644 --- a/HP/src/hp_calc_chi.f90 +++ b/HP/src/hp_calc_chi.f90 @@ -49,7 +49,7 @@ SUBROUTINE calcchi (dns_, chi_, name_) ! IMPLICIT NONE ! - CHARACTER(len=4), INTENT(IN) :: name_ + CHARACTER(len=*), INTENT(IN) :: name_ COMPLEX(DP), INTENT(IN) :: dns_(2*Hubbard_lmax+1, 2*Hubbard_lmax+1, nspin, nat, nqsh) REAL(DP), INTENT(INOUT) :: chi_(nath_sc, nat) ! diff --git a/HP/src/hp_write_chi.f90 b/HP/src/hp_write_chi.f90 index 6fde8777ef..8b87d1de61 100644 --- a/HP/src/hp_write_chi.f90 +++ b/HP/src/hp_write_chi.f90 @@ -49,7 +49,7 @@ SUBROUTINE write_chi (chi_, name_) ! IMPLICIT NONE ! - CHARACTER(len=4), INTENT(IN) :: name_ + CHARACTER(len=*), INTENT(IN) :: name_ REAL(DP), INTENT(IN) :: chi_(nath_sc, nat) INTEGER :: na ! From 4fab5fba598d18b5907e9de499453795c27c4aba Mon Sep 17 00:00:00 2001 From: Ye Luo Date: Thu, 25 Jul 2019 13:24:56 -0400 Subject: [PATCH 85/95] Add pgi support for non-X86 systems. --- install/m4/x_ac_qe_f90.m4 | 56 ++++++++++++++++++------------------ install/m4/x_ac_qe_mpif90.m4 | 2 +- 2 files changed, 29 insertions(+), 29 deletions(-) diff --git a/install/m4/x_ac_qe_f90.m4 b/install/m4/x_ac_qe_f90.m4 index 91d1740775..2beec70d3c 100644 --- a/install/m4/x_ac_qe_f90.m4 +++ b/install/m4/x_ac_qe_f90.m4 @@ -78,19 +78,6 @@ x86_64:nagfor* ) try_dflags="$try_dflags -D__NAG" have_cpp=0 ;; -ia32:pgf* | ia64:pgf* | x86_64:pgf* ) - try_fflags_nomain="-Mnomain" - try_fflags="-fast" - try_fflags_openmp="-mp" - try_f90flags="-fast -Mcache_align -Mpreprocess -Mlarge_arrays" - try_foxflags="-fast -Mcache_align -Mpreprocess -Mlarge_arrays" - try_fflags_noopt="-O0" - try_ldflags="" - try_ldflags_openmp="-mp" - try_ldflags_static="-Bstatic" - try_dflags="$try_dflags -D__PGI" - have_cpp=1 - ;; ia32:path* | ia64:path* | x86_64:path* ) try_fflags="-march=auto -O2" try_f90flags="\$(FFLAGS)" @@ -99,21 +86,6 @@ ia32:path* | ia64:path* | x86_64:path* ) try_ldflags_static="-static" have_cpp=0 ;; -*:*gfortran ) - try_fflags="-O3 -g" - if test "$use_debug" -eq 1; then - try_fflags="-O3 -g -Wall -fbounds-check -frange-check -finit-integer=987654321 -finit-real=nan -finit-logical=true -finit-character=64" - fi - if test "$use_pedantic" -eq 1; then - try_fflags="-O2 -g -pedantic -Wall -Wextra -Wconversion -fimplicit-none -fbacktrace -ffree-line-length-0 -fcheck=all" - fi - try_fflags_openmp="-fopenmp" - try_f90flags="\$(FFLAGS) -x f95-cpp-input" - try_fflags_noopt="-O0 -g" - try_ldflags="-g" - try_ldflags_openmp="-pthread -fopenmp" - try_ldflags_static="-static" - ;; crayxt*:cray* ) try_fflags_nomain="" #NOTE: by default OpenMP is always ON (see crayftn man page) @@ -217,6 +189,34 @@ ppc64-bgq:*xlf* ) pre_fdflags="-WF," xlf_flags=1 ;; +*:pgf* ) + try_fflags_nomain="-Mnomain" + try_fflags="-fast" + try_fflags_openmp="-mp" + try_f90flags="-fast -Mcache_align -Mpreprocess -Mlarge_arrays" + try_foxflags="-fast -Mcache_align -Mpreprocess -Mlarge_arrays" + try_fflags_noopt="-O0" + try_ldflags="" + try_ldflags_openmp="-mp" + try_ldflags_static="-Bstatic" + try_dflags="$try_dflags -D__PGI" + have_cpp=1 + ;; +*:*gfortran ) + try_fflags="-O3 -g" + if test "$use_debug" -eq 1; then + try_fflags="-O3 -g -Wall -fbounds-check -frange-check -finit-integer=987654321 -finit-real=nan -finit-logical=true -finit-character=64" + fi + if test "$use_pedantic" -eq 1; then + try_fflags="-O2 -g -pedantic -Wall -Wextra -Wconversion -fimplicit-none -fbacktrace -ffree-line-length-0 -fcheck=all" + fi + try_fflags_openmp="-fopenmp" + try_f90flags="\$(FFLAGS) -x f95-cpp-input" + try_fflags_noopt="-O0 -g" + try_ldflags="-g" + try_ldflags_openmp="-pthread -fopenmp" + try_ldflags_static="-static" + ;; * ) # unknown, try these diff --git a/install/m4/x_ac_qe_mpif90.m4 b/install/m4/x_ac_qe_mpif90.m4 index 1a53b350c0..ce0c155608 100644 --- a/install/m4/x_ac_qe_mpif90.m4 +++ b/install/m4/x_ac_qe_mpif90.m4 @@ -118,7 +118,7 @@ mpif90=$FC # check which compiler does mpif90 wrap case "$arch" in - ia32 | ia64 | x86_64 | mac686 ) + * ) echo $ECHO_N "checking version of $mpif90... $ECHO_C" ifort_version=`$mpif90 -V 2>&1 | grep "Intel(R)"` pgf_version=`$mpif90 -V 2>&1 | grep "^pgf"` From 6e5f793c832fd2f7015e8a1928fdc2cb4bd6c314 Mon Sep 17 00:00:00 2001 From: fabrizio22 Date: Mon, 29 Jul 2019 12:00:24 +0200 Subject: [PATCH 86/95] fix PAW spinorb --- PW/src/paw_onecenter.f90 | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/PW/src/paw_onecenter.f90 b/PW/src/paw_onecenter.f90 index 8a75a97991..8ebea8a81e 100644 --- a/PW/src/paw_onecenter.f90 +++ b/PW/src/paw_onecenter.f90 @@ -430,17 +430,16 @@ SUBROUTINE PAW_xc_potential(i, rho_lm, rho_core, v_lm, energy) ! INTEGER :: ix,k ! counters on directions and radial grid INTEGER :: lsd ! switch for local spin density - REAL(DP) :: vs !, zeta, amag, vx(2), vc(2), ex, ec !^^^ + REAL(DP) :: vs, amag INTEGER :: kpol INTEGER :: mytid, ntids ! - !^^^****************************************** !^^^ - REAL(DP), ALLOCATABLE :: arho(:,:), zeta(:), amag(:) + !^^^ + REAL(DP), ALLOCATABLE :: arho(:,:) REAL(DP), ALLOCATABLE :: ex(:), ec(:) REAL(DP), ALLOCATABLE :: vx(:,:), vc(:,:) REAL(DP), PARAMETER :: eps = 1.e-30_dp - ! - !^^^************************************* + !^^^ ! #if defined(_OPENMP) INTEGER, EXTERNAL :: omp_get_thread_num, omp_get_num_threads @@ -472,8 +471,6 @@ SUBROUTINE PAW_xc_potential(i, rho_lm, rho_core, v_lm, energy) ALLOCATE( rho_rad(i%m,nspin_mag) ) ! ALLOCATE( arho(i%m,2) ) !^^^ - ALLOCATE( zeta(i%m) ) - ALLOCATE( amag(i%m) ) ALLOCATE( ex(i%m) ) ALLOCATE( ec(i%m) ) ALLOCATE( vx(i%m,2) ) @@ -515,10 +512,12 @@ SUBROUTINE PAW_xc_potential(i, rho_lm, rho_core, v_lm, energy) e_rad(k) = e2*(ex(k)+ec(k))*(rho_rad(k,1)+rho_core(k)*g(i%t)%r2(k)) vs = e2*0.5D0*( vx(k,1) + vc(k,1) - vx(k,2) - vc(k,2) ) v_rad(k,ix,1) = e2*(0.5D0*( vx(k,1) + vc(k,1) + vx(k,2) + vc(k,2))) - IF ( amag(k) > eps12 ) THEN - v_rad(k,ix,2:4) = vs * rho_loc(k,2:4) / amag(k) + amag = SQRT(rho_loc(k,2)**2+rho_loc(k,3)**2+rho_loc(k,4)**2) + IF ( amag > eps12 ) THEN + v_rad(k,ix,2:4) = vs * rho_loc(k,2:4) / amag ELSE v_rad(k,ix,2:4)=0.0_DP + IF (present(energy)) e_rad(k)=0.0_DP ENDIF ENDDO ! @@ -584,9 +583,7 @@ SUBROUTINE PAW_xc_potential(i, rho_lm, rho_core, v_lm, energy) DEALLOCATE( rho_rad ) DEALLOCATE( rho_loc ) ! - DEALLOCATE( arho ) !^^^ - DEALLOCATE( zeta ) - DEALLOCATE( amag ) + DEALLOCATE( arho ) DEALLOCATE( ex ) DEALLOCATE( ec ) DEALLOCATE( vx ) From 6873ae85006a075853f63c62171463d39215da40 Mon Sep 17 00:00:00 2001 From: Oscar Baseggio Date: Mon, 29 Jul 2019 15:13:01 +0200 Subject: [PATCH 87/95] Fixed a bug in TDDFPT code. now wfcdir is initialized --- TDDFPT/src/lr_readin.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TDDFPT/src/lr_readin.f90 b/TDDFPT/src/lr_readin.f90 index ff1cab6482..7f16dd43fd 100644 --- a/TDDFPT/src/lr_readin.f90 +++ b/TDDFPT/src/lr_readin.f90 @@ -54,7 +54,7 @@ SUBROUTINE lr_readin IMPLICIT NONE ! - CHARACTER(LEN=256) :: wfcdir, outdir + CHARACTER(LEN=256) :: wfcdir = 'undefined', outdir CHARACTER(LEN=256), EXTERNAL :: trimcheck ! CHARACTER(LEN=256) :: beta_gamma_z_prefix From 0ae593a4d3d499e62a8da31eb402fa7ca89b7823 Mon Sep 17 00:00:00 2001 From: Oscar Baseggio Date: Mon, 29 Jul 2019 15:26:21 +0200 Subject: [PATCH 88/95] now 'nosym' is define from symm_base (before from input_parameter). So in gamma examples is necessary insert nosym = .true. --- TDDFPT/examples/example01/run_example | 1 + TDDFPT/examples/example02/run_example | 1 + TDDFPT/examples/example03/run_example | 1 + TDDFPT/examples/example04/run_example | 1 + TDDFPT/examples/example05/run_example | 1 + TDDFPT/examples/example06/run_example | 1 + TDDFPT/examples/example07/run_example | 1 + TDDFPT/examples/example08/run_example | 1 + TDDFPT/examples/example09/run_example | 1 + TDDFPT/examples/example10/run_example | 1 + TDDFPT/examples/example11/run_example | 1 + TDDFPT/examples/example12/run_example | 1 + 12 files changed, 12 insertions(+) diff --git a/TDDFPT/examples/example01/run_example b/TDDFPT/examples/example01/run_example index d855d5e0a1..e98732c402 100755 --- a/TDDFPT/examples/example01/run_example +++ b/TDDFPT/examples/example01/run_example @@ -97,6 +97,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 1, celldm(1) = 30, nat = 5, diff --git a/TDDFPT/examples/example02/run_example b/TDDFPT/examples/example02/run_example index 535987f6f0..784252076b 100755 --- a/TDDFPT/examples/example02/run_example +++ b/TDDFPT/examples/example02/run_example @@ -97,6 +97,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 6, celldm(1) = 32.0, celldm(3) = 0.83, diff --git a/TDDFPT/examples/example03/run_example b/TDDFPT/examples/example03/run_example index ac3c50f99d..8e73d60fdf 100755 --- a/TDDFPT/examples/example03/run_example +++ b/TDDFPT/examples/example03/run_example @@ -97,6 +97,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym =.true. ibrav = 6, celldm(1) = 32.0, celldm(3) = 0.83, diff --git a/TDDFPT/examples/example04/run_example b/TDDFPT/examples/example04/run_example index dcbcc75bb9..97b4ccade0 100755 --- a/TDDFPT/examples/example04/run_example +++ b/TDDFPT/examples/example04/run_example @@ -97,6 +97,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 1, celldm(1) = 15, nat = 5, diff --git a/TDDFPT/examples/example05/run_example b/TDDFPT/examples/example05/run_example index 2da2c6c634..fd673fa25a 100755 --- a/TDDFPT/examples/example05/run_example +++ b/TDDFPT/examples/example05/run_example @@ -97,6 +97,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 1, celldm(1) = 15, nat = 5, diff --git a/TDDFPT/examples/example06/run_example b/TDDFPT/examples/example06/run_example index 054cd7696f..261cf15d32 100755 --- a/TDDFPT/examples/example06/run_example +++ b/TDDFPT/examples/example06/run_example @@ -98,6 +98,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 1, celldm(1) = 30, nat = 5, diff --git a/TDDFPT/examples/example07/run_example b/TDDFPT/examples/example07/run_example index ed9ba55569..8a0fa4bd09 100755 --- a/TDDFPT/examples/example07/run_example +++ b/TDDFPT/examples/example07/run_example @@ -116,6 +116,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 1, celldm(1) = 20, nat = 5, diff --git a/TDDFPT/examples/example08/run_example b/TDDFPT/examples/example08/run_example index c357b3a154..c57b5ecb76 100755 --- a/TDDFPT/examples/example08/run_example +++ b/TDDFPT/examples/example08/run_example @@ -97,6 +97,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 1, celldm(1) = 20, nat = 5, diff --git a/TDDFPT/examples/example09/run_example b/TDDFPT/examples/example09/run_example index 9ecbb7f4af..3df12f9313 100755 --- a/TDDFPT/examples/example09/run_example +++ b/TDDFPT/examples/example09/run_example @@ -95,6 +95,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym =.true. ibrav = 6, celldm(1) = 32, celldm(3) = 0.83, diff --git a/TDDFPT/examples/example10/run_example b/TDDFPT/examples/example10/run_example index bf36d34f80..7829ca06a5 100755 --- a/TDDFPT/examples/example10/run_example +++ b/TDDFPT/examples/example10/run_example @@ -96,6 +96,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 1, celldm(1) = 20, nat = 5, diff --git a/TDDFPT/examples/example11/run_example b/TDDFPT/examples/example11/run_example index e6ec138379..549fe2aa1d 100755 --- a/TDDFPT/examples/example11/run_example +++ b/TDDFPT/examples/example11/run_example @@ -114,6 +114,7 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system + nosym = .true. ibrav = 1, celldm(1) = 20, nat = 5, diff --git a/TDDFPT/examples/example12/run_example b/TDDFPT/examples/example12/run_example index f2f5db712f..860b87c189 100755 --- a/TDDFPT/examples/example12/run_example +++ b/TDDFPT/examples/example12/run_example @@ -99,6 +99,7 @@ cat > $PREFIX.scf.in << EOF wf_collect = .true. / &system + nosym = .true. ibrav = 1, celldm(1) = 20, nat = 3, From 120b6c993575c19ca0e40dedb80b6d6ea1db1a00 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrari Date: Tue, 30 Jul 2019 09:26:55 +0000 Subject: [PATCH 89/95] A small fix for enforced input_dft --- Modules/funct.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Modules/funct.f90 b/Modules/funct.f90 index 13c3313715..4bf88de232 100644 --- a/Modules/funct.f90 +++ b/Modules/funct.f90 @@ -799,7 +799,7 @@ FUNCTION matching( fslot, dft, n, name, its_libxc ) its_libxc = .FALSE. matching = notset ! - length = LEN_TRIM( dft ) + length = LEN_TRIM( dft )+1 ! ii = 0 ! From 1848bcb9064ff04a94f866c328eb105705100f73 Mon Sep 17 00:00:00 2001 From: Oscar Baseggio Date: Tue, 30 Jul 2019 16:19:53 +0200 Subject: [PATCH 90/95] solve nosym problem in gamma_only case --- TDDFPT/examples/example01/run_example | 1 - TDDFPT/examples/example02/run_example | 1 - TDDFPT/examples/example03/run_example | 1 - TDDFPT/examples/example04/run_example | 1 - TDDFPT/examples/example05/run_example | 1 - TDDFPT/examples/example06/run_example | 1 - TDDFPT/examples/example07/run_example | 1 - TDDFPT/examples/example08/run_example | 1 - TDDFPT/examples/example09/run_example | 1 - TDDFPT/examples/example10/run_example | 1 - TDDFPT/examples/example11/run_example | 1 - TDDFPT/examples/example12/run_example | 1 - TDDFPT/src/lr_readin.f90 | 5 +++++ 13 files changed, 5 insertions(+), 12 deletions(-) diff --git a/TDDFPT/examples/example01/run_example b/TDDFPT/examples/example01/run_example index e98732c402..d855d5e0a1 100755 --- a/TDDFPT/examples/example01/run_example +++ b/TDDFPT/examples/example01/run_example @@ -97,7 +97,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 1, celldm(1) = 30, nat = 5, diff --git a/TDDFPT/examples/example02/run_example b/TDDFPT/examples/example02/run_example index 784252076b..535987f6f0 100755 --- a/TDDFPT/examples/example02/run_example +++ b/TDDFPT/examples/example02/run_example @@ -97,7 +97,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 6, celldm(1) = 32.0, celldm(3) = 0.83, diff --git a/TDDFPT/examples/example03/run_example b/TDDFPT/examples/example03/run_example index 8e73d60fdf..ac3c50f99d 100755 --- a/TDDFPT/examples/example03/run_example +++ b/TDDFPT/examples/example03/run_example @@ -97,7 +97,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym =.true. ibrav = 6, celldm(1) = 32.0, celldm(3) = 0.83, diff --git a/TDDFPT/examples/example04/run_example b/TDDFPT/examples/example04/run_example index 97b4ccade0..dcbcc75bb9 100755 --- a/TDDFPT/examples/example04/run_example +++ b/TDDFPT/examples/example04/run_example @@ -97,7 +97,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 1, celldm(1) = 15, nat = 5, diff --git a/TDDFPT/examples/example05/run_example b/TDDFPT/examples/example05/run_example index fd673fa25a..2da2c6c634 100755 --- a/TDDFPT/examples/example05/run_example +++ b/TDDFPT/examples/example05/run_example @@ -97,7 +97,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 1, celldm(1) = 15, nat = 5, diff --git a/TDDFPT/examples/example06/run_example b/TDDFPT/examples/example06/run_example index 261cf15d32..054cd7696f 100755 --- a/TDDFPT/examples/example06/run_example +++ b/TDDFPT/examples/example06/run_example @@ -98,7 +98,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 1, celldm(1) = 30, nat = 5, diff --git a/TDDFPT/examples/example07/run_example b/TDDFPT/examples/example07/run_example index 8a0fa4bd09..ed9ba55569 100755 --- a/TDDFPT/examples/example07/run_example +++ b/TDDFPT/examples/example07/run_example @@ -116,7 +116,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 1, celldm(1) = 20, nat = 5, diff --git a/TDDFPT/examples/example08/run_example b/TDDFPT/examples/example08/run_example index c57b5ecb76..c357b3a154 100755 --- a/TDDFPT/examples/example08/run_example +++ b/TDDFPT/examples/example08/run_example @@ -97,7 +97,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 1, celldm(1) = 20, nat = 5, diff --git a/TDDFPT/examples/example09/run_example b/TDDFPT/examples/example09/run_example index 3df12f9313..9ecbb7f4af 100755 --- a/TDDFPT/examples/example09/run_example +++ b/TDDFPT/examples/example09/run_example @@ -95,7 +95,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym =.true. ibrav = 6, celldm(1) = 32, celldm(3) = 0.83, diff --git a/TDDFPT/examples/example10/run_example b/TDDFPT/examples/example10/run_example index 7829ca06a5..bf36d34f80 100755 --- a/TDDFPT/examples/example10/run_example +++ b/TDDFPT/examples/example10/run_example @@ -96,7 +96,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 1, celldm(1) = 20, nat = 5, diff --git a/TDDFPT/examples/example11/run_example b/TDDFPT/examples/example11/run_example index 549fe2aa1d..e6ec138379 100755 --- a/TDDFPT/examples/example11/run_example +++ b/TDDFPT/examples/example11/run_example @@ -114,7 +114,6 @@ cat > $PREFIX.scf.in << EOF outdir='$TMP_DIR/' / &system - nosym = .true. ibrav = 1, celldm(1) = 20, nat = 5, diff --git a/TDDFPT/examples/example12/run_example b/TDDFPT/examples/example12/run_example index 860b87c189..f2f5db712f 100755 --- a/TDDFPT/examples/example12/run_example +++ b/TDDFPT/examples/example12/run_example @@ -99,7 +99,6 @@ cat > $PREFIX.scf.in << EOF wf_collect = .true. / &system - nosym = .true. ibrav = 1, celldm(1) = 20, nat = 3, diff --git a/TDDFPT/src/lr_readin.f90 b/TDDFPT/src/lr_readin.f90 index 7f16dd43fd..861c3be1ef 100644 --- a/TDDFPT/src/lr_readin.f90 +++ b/TDDFPT/src/lr_readin.f90 @@ -438,6 +438,11 @@ SUBROUTINE input_sanity() & CALL errore ('lr_readin', & & 'projection is possible only in charge response mode 1', 1 ) ! + IF (gamma_only) THEN + nosym=.true. + WRITE(stdout,*) "Symmetries are disabled for the gamma_only case" + ENDIF + ! ENDIF ! ! Meta-DFT currently not supported by TDDFPT From ba7f43b48908d4c7a6b118ff3c66e2411325c5ca Mon Sep 17 00:00:00 2001 From: Samuel Ponce Date: Thu, 1 Aug 2019 16:13:37 +0100 Subject: [PATCH 91/95] Add a new input variable that controls the nb of conduction carriers in the Ziman's conductivity formula. --- EPW/src/a2f.f90 | 4 ++-- EPW/src/epw_readin.f90 | 6 ++++-- EPW/src/epwcom.f90 | 2 ++ 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/EPW/src/a2f.f90 b/EPW/src/a2f.f90 index a12600198f..d986e4e7ba 100644 --- a/EPW/src/a2f.f90 +++ b/EPW/src/a2f.f90 @@ -29,7 +29,7 @@ SUBROUTINE eliashberg_a2f USE phcom, ONLY : nmodes USE cell_base, ONLY : omega USE epwcom, ONLY : degaussq, delta_qsmear, nqsmear, nqstep, nsmear, eps_acustic, & - delta_smear, degaussw, fsthick + delta_smear, degaussw, fsthick, nc USE elph2, ONLY : nqtotf, wf, wqf, lambda_all, lambda_v_all USE constants_epw, ONLY : ryd2mev, ryd2ev, kelvin2eV, two, zero, kelvin2Ry, pi USE mp, ONLY : mp_barrier, mp_sum @@ -214,7 +214,7 @@ SUBROUTINE eliashberg_a2f ! Usually this means "the number of electrons that contribute to the mobility" and so it is typically 8 (full shell) ! but not always. You might want to check this. ! - n = 8.0 / omega + n = nc / omega !print*,'omega ',omega WRITE (iures, '(a)') '# Temperature [K] Resistivity [micro Ohm cm] for different Phonon smearing (meV) ' WRITE (iures, '("# ", 15f12.7)') ( (degaussq+(ismear-1)*delta_qsmear)*ryd2mev,ismear=1,nqsmear ) diff --git a/EPW/src/epw_readin.f90 b/EPW/src/epw_readin.f90 index 40c360c712..f38a1f69bc 100644 --- a/EPW/src/epw_readin.f90 +++ b/EPW/src/epw_readin.f90 @@ -51,7 +51,7 @@ SUBROUTINE epw_readin cumulant, bnd_cum, proj, write_wfn, iswitch, ntempxx, & liso, lacon, lpade, etf_mem, epbwrite, & nsiter, conv_thr_racon, specfun_el, specfun_ph, & - pwc, nswc, nswfc, nswi, & + pwc, nswc, nswfc, nswi, nc, & nbndsub, nbndskip, system_2d, delta_approx, & title, int_mob, scissor, iterative_bte, scattering, & ncarrier, carrier, scattering_serta, restart, restart_freq, & @@ -113,7 +113,7 @@ SUBROUTINE epw_readin wannierize, dis_win_max, dis_win_min, dis_froz_min, dis_froz_max, & num_iter, proj, bands_skipped, wdata, iprint, write_wfn, & wmin, wmax, nw, eps_acustic, a2f, nest_fn, plselfen, & - elecselfen, phonselfen, use_ws, & + elecselfen, phonselfen, use_ws, nc, & rand_q, rand_nq, rand_k, rand_nk, specfun_pl, & nqf1, nqf2, nqf3, nkf1, nkf2, nkf3, & mp_mesh_k, mp_mesh_q, filqf, filkf, ephwrite, & @@ -290,6 +290,7 @@ SUBROUTINE epw_readin ! use_ws : If .true., use the Wannier-center to create the Wigner-Seitz cell. ! epmatkqread : If .true., restart an IBTE calculation from scattering written to files. ! selecqread : If .true., restart from the selecq.fmt file + ! nc : Number of carrier for the Ziman resistivity formula (can be fractional) ! ! Added by Manos Kioupakis ! omegamin : Photon energy minimum @@ -488,6 +489,7 @@ SUBROUTINE epw_readin use_ws = .false. epmatkqread = .false. selecqread = .false. + nc = 4.0d0 ! ! reading the namelist inputepw ! diff --git a/EPW/src/epwcom.f90 b/EPW/src/epwcom.f90 index 45afac8765..82e78e9db3 100644 --- a/EPW/src/epwcom.f90 +++ b/EPW/src/epwcom.f90 @@ -148,6 +148,8 @@ MODULE control_epw !! Value of the scissor shift in eV. REAL (KIND=DP) :: ncarrier !! Amount of carrier concentration in cm^-3 when doping a semiconductors + REAL (KIND=DP) :: nc + !! Number of carrier per unit cell that participate to the conduction in the Ziman resistivity formula ! ! Plasmon REAL (KIND=DP) :: nel From 941f69fb1dfb6ff997e5abbed1041d182108e0b3 Mon Sep 17 00:00:00 2001 From: Oscar Baseggio Date: Tue, 30 Jul 2019 09:33:13 +0200 Subject: [PATCH 92/95] create ph_lanczos_iter.f90 and bo_lanczos_iter.f90; and move lr_dot.f90 from TDDFPT/src to LR_Modules --- LR_Modules/Makefile | 5 +- LR_Modules/bo_lanczos_iter.f90 | 122 ++++++++++++++++++++++++++ {TDDFPT/src => LR_Modules}/lr_dot.f90 | 77 ++++++++-------- LR_Modules/ph_lanczos_iter.f90 | 116 ++++++++++++++++++++++++ TDDFPT/src/Makefile | 1 - TDDFPT/src/lr_lanczos.f90 | 111 ++++++++--------------- TDDFPT/src/lr_readin.f90 | 4 + 7 files changed, 319 insertions(+), 117 deletions(-) create mode 100644 LR_Modules/bo_lanczos_iter.f90 rename {TDDFPT/src => LR_Modules}/lr_dot.f90 (87%) create mode 100644 LR_Modules/ph_lanczos_iter.f90 diff --git a/LR_Modules/Makefile b/LR_Modules/Makefile index eff92da96b..8e91253eda 100644 --- a/LR_Modules/Makefile +++ b/LR_Modules/Makefile @@ -53,7 +53,10 @@ lr_orthoUwfc.o \ qdipol_cryst.o \ mode_group.o \ mix_pot.o \ -lrcom.o +lrcom.o \ +lr_dot.o \ +ph_lanczos_iter.o \ +bo_lanczos_iter.o TLDEPS=mods pwlibs diff --git a/LR_Modules/bo_lanczos_iter.f90 b/LR_Modules/bo_lanczos_iter.f90 new file mode 100644 index 0000000000..98cb6939fb --- /dev/null +++ b/LR_Modules/bo_lanczos_iter.f90 @@ -0,0 +1,122 @@ +subroutine bo_lanczos_iter(j, npwx_npol, nbnd_occ, nksq, qj, Aqj, Sqj, qjold, n_ipol, u, alpha, beta, gamma, zeta) + ! + !! Bi-Orthogonal Lanczos algorithm + !! + !! $$ g(w) =\sum_j (u,q_j){q_j,(w-A)^(-1)q} + !! Algorithm 1 in "Computer Physics Communications 185 (2014) 2080-2089" + !! + !! this subroutine generates alpha, beta and gamma coefficients (the + !! tridiagonal matrix elements), z = (u,q_j) elements. And update + !! Lanczos vectors + ! + USE kinds, ONLY : dp + ! + INTEGER, INTENT(IN) :: j + !! iteration index + INTEGER, INTENT(IN) :: npwx_npol + !! firts dimension of qj, Aqj, SAqj, qjold, u in qe npwx*npol + INTEGER, INTENT(IN) :: nbnd_occ + !! second dimension of qj, Aqj, SAqj, qjold, n_ipol, u in qe nbnd + INTEGER, INTENT(IN) :: nksq + !! third dimension of qj, Aqj, SAqj, qjold, n_ipol, u in qe nksq + INTEGER, INTENT(IN) :: n_ipol + !! polarization, forth dimension of u and dimension of zeta + COMPLEX(kind=dp), INTENT(IN) :: Aqj(npwx_npol,nbnd_occ,nksq, 2) + !! operator applied to qj vector + COMPLEX(kind=dp), INTENT(IN) :: u(npwx_npol,nbnd_occ,nksq,n_ipol) + !! second lanczos vector, in qe d0psi (q0psi2 for eels) + COMPLEX(kind=dp), INTENT(IN) :: Sqj(npwx_npol,nbnd_occ,nksq) + !! S operator applied to qj vector only for USPP, otherwise a copy of qj + COMPLEX(kind=dp), INTENT(INOUT) :: qj(npwx_npol,nbnd_occ,nksq, 2) + !! qj vector, become qj+1 vector + COMPLEX(kind=dp), INTENT(INOUT) :: qjold(npwx_npol,nbnd_occ,nksq, 2) + !! qj-1 vector, become qj vector + REAL(kind=dp), INTENT(OUT) :: alpha + !! diagonal cofficient of the tridiagonal matrix + REAL(kind=dp), INTENT(OUT) :: beta + !! lower coefficient of the tridiagonal matrix + REAL(kind=dp), INTENT(OUT) :: gamma + !! upper coefficient of the tridiagonal matrix + COMPLEX(kind=dp), INTENT(OUT) :: zeta(n_ipol) + !! (u,q_j) products + ! + COMPLEX(kind=dp),EXTERNAL :: lr_dot + ! + INTEGER :: size_evc, ip + ! + size_evc = npwx_npol*nbnd_occ*nksq + ! + ! By construction =0 should be 0, forcing this both conserves + ! resources and increases stability. + ! + alpha = 0.0d0 + ! + ! Orthogonality requirement: = 1 + ! + beta = dble(lr_dot(qj(:,:,:,1), Sqj(:,:,:))) + ! + IF ( beta<0.0d0 ) THEN + ! + beta = sqrt(-beta) + gamma = -beta + ! + ELSEIF ( beta>0.0d0 ) THEN + ! + ! X. Ge: Actually, this is the only case in the pseudo-Hermitian + ! algorithm. + ! + beta = sqrt(beta) + gamma = beta + ! + ENDIF + ! + ! Renormalize q(i) and Lq(i), also p(i) and Lp(i) in the non-Hermitian case + ! + CALL zscal(size_evc,cmplx(1.0d0/beta,0.0d0,kind=dp),qj(1,1,1,1),1) + CALL zscal(size_evc,cmplx(1.0d0/beta,0.0d0,kind=dp),Aqj(1,1,1,1),1) + ! + CALL zscal(size_evc,cmplx(1.0d0/gamma,0.0d0,kind=dp),qj(1,1,1,2),1) + CALL zscal(size_evc,cmplx(1.0d0/gamma,0.0d0,kind=dp),Aqj(1,1,1,2),1) + ! + ! Calculation of zeta coefficients. + ! See Eq.(35) in Malcioglu et al., Comput. Phys. Commun. 182, 1744 (2011). + ! + IF (mod(j,2)==0) THEN + ! + DO ip = 1, n_ipol + ! + ! Optics: In the ultrasoft case, the S operator was already + ! applied to d0psi, so we have . + ! + zeta(ip) = lr_dot(u(:,:,:,ip),qj(:,:,:,1)) + ! + ENDDO + ! + ELSE + ! + DO ip = 1, n_ipol + ! + zeta(ip) = (0.0d0,0.0d0) + ! + ENDDO + ! + ENDIF + ! + ! X. Ge: q(i+1) = Lq(i) - beta(i)*q(i-1); + ! Renormalization will be done in the begining of the next iteration. + ! In the non-Hermitian case, similar operation needs to be done also for p(i). + ! + CALL zaxpy(size_evc,-cmplx(gamma,0.0d0,kind=dp),qjold(1,1,1,1),1,Aqj(1,1,1,1),1) + CALL zaxpy(size_evc,-cmplx(beta,0.0d0,kind=dp),qjold(1,1,1,2),1,Aqj(1,1,1,2),1) + ! + ! X. Ge: Throw away q(i-1), and make q(i+1) to be the current vector, + ! be ready for the next iteration. Aqj will be free again after this + ! step + ! + CALL zcopy(size_evc,qj(1,1,1,1),1,qjold(1,1,1,1),1) ! qjold = qj + CALL zcopy(size_evc,Aqj(1,1,1,1),1,qj(1,1,1,1),1) ! qj = Aqj + ! + CALL zcopy(size_evc,qj(1,1,1,2),1,qjold(1,1,1,2),1) ! qjold = qj + CALL zcopy(size_evc,Aqj(1,1,1,2),1,qj(1,1,1,2),1) ! qj = Aqj + ! +end subroutine bo_lanczos_iter diff --git a/TDDFPT/src/lr_dot.f90 b/LR_Modules/lr_dot.f90 similarity index 87% rename from TDDFPT/src/lr_dot.f90 rename to LR_Modules/lr_dot.f90 index 8b60688841..792d61c855 100644 --- a/TDDFPT/src/lr_dot.f90 +++ b/LR_Modules/lr_dot.f90 @@ -27,7 +27,6 @@ FUNCTION lr_dot(x,y) USE gvect, ONLY : gstart, ngm, g USE mp, ONLY : mp_sum USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm - USE lr_variables, ONLY : lr_verbosity, eels USE noncollin_module, ONLY : noncolin, npol USE control_lr, ONLY : nbnd_occ USE qpoint, ONLY : nksq @@ -37,53 +36,40 @@ FUNCTION lr_dot(x,y) COMPLEX(kind=dp) :: x(npwx*npol,nbnd,nksq), & y(npwx*npol,nbnd,nksq) COMPLEX(kind=dp) :: lr_dot - COMPLEX(kind=dp) :: temp_k REAL(kind=dp) :: temp_gamma, degspin INTEGER :: ibnd, ik REAL(kind=dp), EXTERNAL :: DDOT COMPLEX(kind=dp), EXTERNAL :: ZDOTC ! - IF (lr_verbosity > 5) THEN - WRITE(stdout,'("")') - ENDIF - ! CALL start_clock ('lr_dot') ! lr_dot = (0.0d0,0.0d0) temp_gamma = 0.0d0 - temp_k = (0.0d0,0.0d0) ! IF (nspin==2) THEN degspin = 1.0d0 ELSE degspin = 2.0d0 ENDIF - IF (noncolin) degspin = 1.0d0 ! - IF (eels) THEN + IF (gamma_only) THEN + ! + CALL lr_dot_gamma() + lr_dot = cmplx(temp_gamma,0.0d0,dp) ! - CALL lr_dot_k_eels() + ELSEIF (noncolin) THEN + ! + degspin = 1.0d0 + CALL lr_dot_k_nc() ! ELSE ! - IF (gamma_only) THEN - ! - CALL lr_dot_gamma() - lr_dot = cmplx(temp_gamma,0.0d0,dp) - ! - ELSE - ! - CALL lr_dot_k() - lr_dot = temp_k - ! - ENDIF + CALL lr_dot_k() ! ENDIF ! lr_dot = lr_dot/degspin ! - IF (lr_verbosity > 5) WRITE(stdout,'("")') - ! CALL stop_clock ('lr_dot') ! RETURN @@ -113,32 +99,45 @@ SUBROUTINE lr_dot_gamma ! END SUBROUTINE lr_dot_gamma ! - SUBROUTINE lr_dot_k + SUBROUTINE lr_dot_k_nc ! - ! Optical case: generalized k point case - ! Noncollinear case is not implemented + ! Noncollinear case ! - DO ik=1,nks - DO ibnd=1,nbnd + USE qpoint, ONLY : ikks, ikqs + ! + IMPLICIT NONE + INTEGER :: ios + INTEGER :: ik, & + ikk, & ! index of the point k + ikq, & ! index of the point k+q + npwq ! number of the plane-waves at point k+q + ! + DO ik = 1, nksq + ! + ikk = ikks(ik) + ikq = ikqs(ik) + npwq = ngk(ikq) + ! + DO ibnd = 1, nbnd_occ(ikk) ! - temp_k = temp_k + wg(ibnd,ik) * ZDOTC(ngk(ik),x(1,ibnd,ik),1,y(1,ibnd,ik),1) + lr_dot = lr_dot + wk(ikk) *ZDOTC(npwx*npol,x(1,ibnd,ik),1,y(1,ibnd,ik),1) ! ENDDO + ! ENDDO ! #if defined(__MPI) - CALL mp_sum(temp_k, inter_pool_comm) - CALL mp_sum(temp_k, intra_bgrp_comm) + CALL mp_sum(lr_dot, inter_pool_comm) + CALL mp_sum(lr_dot, intra_bgrp_comm) #endif ! RETURN ! - END SUBROUTINE lr_dot_k + END SUBROUTINE lr_dot_k_nc ! - SUBROUTINE lr_dot_k_eels + SUBROUTINE lr_dot_k ! - ! EELS - ! Noncollinear case is implemented + ! collinear k point case ! USE qpoint, ONLY : ikks, ikqs ! @@ -157,11 +156,7 @@ SUBROUTINE lr_dot_k_eels ! DO ibnd = 1, nbnd_occ(ikk) ! - IF (noncolin) THEN - lr_dot = lr_dot + wk(ikk) * ZDOTC(npwx*npol,x(1,ibnd,ik),1,y(1,ibnd,ik),1) - ELSE - lr_dot = lr_dot + wk(ikk) * ZDOTC(npwq,x(1,ibnd,ik),1,y(1,ibnd,ik),1) - ENDIF + lr_dot = lr_dot + wk(ikk) * ZDOTC(npwq,x(1,ibnd,ik),1,y(1,ibnd,ik),1) ! ENDDO ! @@ -174,7 +169,7 @@ SUBROUTINE lr_dot_k_eels ! RETURN ! - END SUBROUTINE lr_dot_k_eels + END SUBROUTINE lr_dot_k ! END FUNCTION lr_dot !----------------------------------------------------------------------- diff --git a/LR_Modules/ph_lanczos_iter.f90 b/LR_Modules/ph_lanczos_iter.f90 new file mode 100644 index 0000000000..3d1907229a --- /dev/null +++ b/LR_Modules/ph_lanczos_iter.f90 @@ -0,0 +1,116 @@ +subroutine ph_lanczos_iter(j, npwx_npol, nbnd_occ, nksq, qj, Aqj, SAqj, qjold, n_ipol, u, alpha, beta, gamma, zeta) + ! + !! Pseudo-Hermitian Lanczos algorithm + !! + !! $$ g(w) =\sum_j (u,q_j){q_j,(w-A)^(-1)q} + !! Algorithm 2 in "Computer Physics Communications 185 (2014) 2080-2089" + !! + !! this subroutine generates alpha, beta and gamma coefficients (the + !! tridiagonal matrix elements), z = (u,q_j) elements. And update + !! Lanczos vectors + !! + ! + USE kinds, ONLY : dp + ! + INTEGER, INTENT(IN) :: j + !! iteration index + INTEGER, INTENT(IN) :: npwx_npol + !! firts dimension of qj, Aqj, SAqj, qjold, u in qe npwx*npol + INTEGER, INTENT(IN) :: nbnd_occ + !! second dimension of qj, Aqj, SAqj, qjold, n_ipol, u in qe nbnd + INTEGER, INTENT(IN) :: nksq + !! third dimension of qj, Aqj, SAqj, qjold, n_ipol, u in qe nksq + INTEGER, INTENT(IN) :: n_ipol + !! polarization, forth dimension of u and dimension of zeta + COMPLEX(kind=dp), INTENT(IN) :: Aqj(npwx_npol,nbnd_occ,nksq) + !! operator applied to qj vector + COMPLEX(kind=dp), INTENT(IN) :: u(npwx_npol,nbnd_occ,nksq,n_ipol) + !! second lanczos vector, in qe d0psi (dopsi2 for eels) + COMPLEX(kind=dp), INTENT(IN) :: SAqj(npwx_npol,nbnd_occ,nksq) + !! S operator applied to Aqj vector only for USPP, otherwise a copy of Aqj + COMPLEX(kind=dp), INTENT(INOUT) :: qj(npwx_npol,nbnd_occ,nksq) + !! qj vector, become qj+1 vector + COMPLEX(kind=dp), INTENT(INOUT) :: qjold(npwx_npol,nbnd_occ,nksq) + !! qj-1 vector, become qj vector + REAL(kind=dp), INTENT(OUT) :: alpha + !! diagonal cofficient of the tridiagonal matrix + REAL(kind=dp), INTENT(OUT) :: beta + !! lower coefficient of the tridiagonal matrix + REAL(kind=dp), INTENT(OUT) :: gamma + !! upper coefficient of the tridiagonal matrix + COMPLEX(kind=dp), INTENT(OUT) :: zeta(n_ipol) + !! (u,q_j) products + ! + COMPLEX(kind=dp),EXTERNAL :: lr_dot + ! + INTEGER :: size_evc, ip + ! + size_evc = npwx_npol*nbnd_occ*nksq + ! + ! By construction =0 should be 0, forcing this both conserves + ! resources and increases stability. + ! + alpha = 0.0d0 + ! + ! Orthogonality requirement: = 1 + ! + beta = dble(lr_dot(qj(:,:,:), SAqj(:,:,:))) + ! + IF ( beta<0.0d0 ) THEN + ! + beta = sqrt(-beta) + gamma = -beta + ! + ELSEIF ( beta>0.0d0 ) THEN + ! + ! X. Ge: Actually, this is the only case in the pseudo-Hermitian + ! algorithm. + ! + beta = sqrt(beta) + gamma = beta + ! + ENDIF + ! + ! Renormalize q(i) and Lq(i) + ! + CALL zscal(size_evc,cmplx(1.0d0/beta,0.0d0,kind=dp),qj(1,1,1),1) + CALL zscal(size_evc,cmplx(1.0d0/beta,0.0d0,kind=dp),Aqj(1,1,1),1) + ! + ! Calculation of zeta coefficients. + ! See Eq.(35) in Malcioglu et al., Comput. Phys. Commun. 182, 1744 (2011). + ! + IF (mod(j,2)==0) THEN + ! + DO ip = 1, n_ipol + ! + ! Optics: In the ultrasoft case, the S operator was already + ! applied to d0psi, so we have . + ! + zeta(ip) = lr_dot(u(:,:,:,ip),qj(:,:,:)) + ! + ENDDO + ! + ELSE + ! + DO ip = 1, n_ipol + ! + zeta(ip) = (0.0d0,0.0d0) + ! + ENDDO + ! + ENDIF + ! + ! X. Ge: q(i+1) = Lq(i) - beta(i)*q(i-1); + ! Renormalization will be done in the begining of the next iteration. + ! In the non-Hermitian case, similar operation needs to be done also for p(i). + ! + CALL zaxpy(size_evc,-cmplx(gamma,0.0d0,kind=dp),qjold(1,1,1),1,Aqj(1,1,1),1) + ! + ! X. Ge: Throw away q(i-1), and make q(i+1) to be the current vector, + ! be ready for the next iteration. Aqj will be free again after this + ! step + ! + CALL zcopy(size_evc,qj(1,1,1),1,qjold(1,1,1),1) ! qjold = qj + CALL zcopy(size_evc,Aqj(1,1,1),1,qj(1,1,1),1) ! qj = Aqj + ! +end subroutine ph_lanczos_iter diff --git a/TDDFPT/src/Makefile b/TDDFPT/src/Makefile index 889bbac53f..372c2fd551 100644 --- a/TDDFPT/src/Makefile +++ b/TDDFPT/src/Makefile @@ -21,7 +21,6 @@ bcast_lr_input.o \ lr_readin.o \ lr_alloc_init.o \ lr_calc_dens.o \ -lr_dot.o \ lr_dealloc.o \ lr_ortho.o \ lr_read_wf.o \ diff --git a/TDDFPT/src/lr_lanczos.f90 b/TDDFPT/src/lr_lanczos.f90 index adaa614eab..86102d374c 100644 --- a/TDDFPT/src/lr_lanczos.f90 +++ b/TDDFPT/src/lr_lanczos.f90 @@ -72,7 +72,7 @@ SUBROUTINE one_lanczos_step() ! Local variables ! REAL(kind=dp) :: alpha, beta, gamma, angle - COMPLEX(kind=dp) :: zeta + COMPLEX(kind=dp) :: zeta(n_ipol) INTEGER(kind=c_int) :: kilobytes ! IF (lr_verbosity > 5) THEN @@ -150,13 +150,6 @@ SUBROUTINE one_lanczos_step() ! ENDIF ! - ! By construction =0 should be 0, forcing this both conserves - ! resources and increases stability. - ! - alpha = 0.0d0 - alpha_store(pol_index,LR_iteration) = alpha - WRITE(stdout,'(5X,"alpha(",i8.8,")=",f10.6)') LR_iteration, alpha - ! ! Apply S operator if USPP, otherwise just copy ! one array into another. ! @@ -166,13 +159,37 @@ SUBROUTINE one_lanczos_step() CALL lr_apply_s(evc1(:,:,:,2), sevc1(:,:,:)) ENDIF ! - ! Orthogonality requirement: = 1 + ! call general lanczos iteration routines + ! O. Baseggio (2019) ! IF (pseudo_hermitian) THEN - beta = dble(lr_dot(evc1(:,:,:,1), sevc1_new(:,:,:))) + IF (eels) THEN + CALL ph_lanczos_iter(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& + &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1_new(:,:,:), & + &evc1_old(:,:,:,1), n_ipol, d0psi2, alpha, beta, & + &gamma, zeta) + ELSE + CALL ph_lanczos_iter(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& + &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1_new(:,:,:), & + &evc1_old(:,:,:,1), n_ipol, d0psi(:,:,:,:), alpha, beta, & + &gamma, zeta) + ENDIF ELSE - beta = dble(lr_dot(evc1(:,:,:,1), sevc1(:,:,:))) - ENDIF + IF (eels) THEN + CALL bo_lanczos_iter(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& + &evc1(:,:,:,:), evc1_new(:,:,:,:), sevc1(:,:,:), & + &evc1_old(:,:,:,1), n_ipol, d0psi2, alpha, beta, & + &gamma, zeta) + ELSE + CALL bo_lanczos_iter(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& + &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1(:,:,:), & + &evc1_old(:,:,:,1), n_ipol, d0psi, alpha, beta, & + &gamma, zeta) + ENDIF + ENDIF + ! + alpha_store(pol_index,LR_iteration) = alpha + WRITE(stdout,'(5X,"alpha(",i8.8,")=",f10.6)') LR_iteration, alpha ! ! beta<0 is a serious error for the pseudo-Hermitian algorithm ! @@ -183,18 +200,6 @@ SUBROUTINE one_lanczos_step() WRITE(stdout,'(5x,"lr_lanczos: Left and right Lanczos vectors are orthogonal, & & this is a violation of oblique projection")') ! - ELSEIF ( beta<0.0d0 ) THEN - ! - beta = sqrt(-beta) - gamma = -beta - ! - ELSEIF ( beta>0.0d0 ) THEN - ! - ! X. Ge: Actually, this is the only case in the pseudo-Hermitian algorithm. - ! - beta = sqrt(beta) - gamma = beta - ! ENDIF ! beta_store (pol_index,LR_iteration) = beta @@ -224,34 +229,12 @@ SUBROUTINE one_lanczos_step() ! ENDIF ! - ! Renormalize q(i) and Lq(i), also p(i) and Lp(i) in the non-Hermitian case - ! - CALL zscal(size_evc,cmplx(1.0d0/beta,0.0d0,kind=dp),evc1(1,1,1,1),1) - CALL zscal(size_evc,cmplx(1.0d0/beta,0.0d0,kind=dp),evc1_new(1,1,1,1),1) - ! - IF (.not.pseudo_hermitian) THEN - CALL zscal(size_evc,cmplx(1.0d0/gamma,0.0d0,kind=dp),evc1(1,1,1,2),1) - CALL zscal(size_evc,cmplx(1.0d0/gamma,0.0d0,kind=dp),evc1_new(1,1,1,2),1) - ENDIF - ! - ! Calculation of zeta coefficients. - ! See Eq.(35) in Malcioglu et al., Comput. Phys. Commun. 182, 1744 (2011). - ! IF (mod(LR_iteration,2)==0) THEN ! DO ip = 1, n_ipol ! - ! Optics: In the ultrasoft case, the S operator was already - ! applied to d0psi, so we have . - ! - IF (eels) THEN - zeta = lr_dot(d0psi2(:,:,:,ip),evc1(:,:,:,1)) - ELSE - zeta = lr_dot(d0psi(:,:,:,ip),evc1(:,:,:,1)) - ENDIF - ! - zeta_store (pol_index,ip,LR_iteration) = zeta - WRITE(stdout,'(5x,"z1= ",1x,i6,2(1x,e22.15))') ip,real(zeta),aimag(zeta) + zeta_store (pol_index,ip,LR_iteration) = zeta(ip) + WRITE(stdout,'(5x,"z1= ",1x,i6,2(1x,e22.15))') ip,real(zeta(ip)),aimag(zeta(ip)) ! ENDDO ! @@ -259,30 +242,21 @@ SUBROUTINE one_lanczos_step() ! lets calculate the response related observables. ! IF (charge_response == 1 .and. .not.eels) THEN - CALL lr_calc_dens(evc1(:,:,:,1), .true.) - CALL lr_calc_F(evc1(:,:,:,1)) + CALL lr_calc_dens(evc1_old(:,:,:,1), .true.) + CALL lr_calc_F(evc1_old(:,:,:,1)) ENDIF ! ELSE ! DO ip = 1, n_ipol ! - zeta = (0.0d0,0.0d0) - zeta_store (pol_index,ip,LR_iteration) = zeta - WRITE(stdout,'(5x,"z1= ",1x,i6,2(1x,e22.15))') ip,real(zeta),aimag(zeta) + zeta_store (pol_index,ip,LR_iteration) = zeta(ip) + WRITE(stdout,'(5x,"z1= ",1x,i6,2(1x,e22.15))') ip,real(zeta(ip)),aimag(zeta(ip)) ! ENDDO ! ENDIF ! - ! X. Ge: q(i+1) = Lq(i) - beta(i)*q(i-1); - ! Renormalization will be done in the begining of the next iteration. - ! In the non-Hermitian case, similar operation needs to be done also for p(i). - ! - CALL zaxpy(size_evc,-cmplx(gamma,0.0d0,kind=dp),evc1_old(1,1,1,1),1,evc1_new(1,1,1,1),1) - IF (.not. pseudo_hermitian) & - CALL zaxpy(size_evc,-cmplx(beta,0.0d0,kind=dp),evc1_old(1,1,1,2),1,evc1_new(1,1,1,2),1) - ! ! X. Ge: To increase the stability, apply lr_ortho. ! I.Timrov: Actually, without this trick, it turns out that ! the Lanczos chain is not stable when pseudo_hermitian=.false., @@ -293,24 +267,13 @@ SUBROUTINE one_lanczos_step() IF (.not.eels) THEN ! DO ik=1, nks - CALL lr_ortho(evc1_new(:,:,ik,1), evc0(:,:,ik), ik, ik, sevc0(:,:,ik),.true.) + CALL lr_ortho(evc1(:,:,ik,1), evc0(:,:,ik), ik, ik, sevc0(:,:,ik),.true.) IF (.not. pseudo_hermitian) & - CALL lr_ortho(evc1_new(:,:,ik,2), evc0(:,:,ik), ik, ik, sevc0(:,:,ik),.true.) + CALL lr_ortho(evc1(:,:,ik,2), evc0(:,:,ik), ik, ik, sevc0(:,:,ik),.true.) ENDDO ! ENDIF ! - ! X. Ge: Throw away q(i-1), and make q(i+1) to be the current vector, - ! be ready for the next iteration. evc1_new will be free again after this step - ! - CALL zcopy(size_evc,evc1(1,1,1,1),1,evc1_old(1,1,1,1),1) ! evc1_old = evc1 - CALL zcopy(size_evc,evc1_new(1,1,1,1),1,evc1(1,1,1,1),1) ! evc1 = evc1_new - ! - IF (.not.pseudo_hermitian) THEN - CALL zcopy(size_evc,evc1(1,1,1,2),1,evc1_old(1,1,1,2),1) ! evc1_old = evc1 - CALL zcopy(size_evc,evc1_new(1,1,1,2),1,evc1(1,1,1,2),1) ! evc1 = evc1_new - ENDIF - ! IF (ionode) THEN IF ( charge_response == 1 .and. lr_verbosity > 0) THEN WRITE (stdout,'(5x,"(calc=",e22.15," read=",e22.15,")")') & diff --git a/TDDFPT/src/lr_readin.f90 b/TDDFPT/src/lr_readin.f90 index 861c3be1ef..f829caf614 100644 --- a/TDDFPT/src/lr_readin.f90 +++ b/TDDFPT/src/lr_readin.f90 @@ -197,6 +197,9 @@ SUBROUTINE lr_readin ! ! Set-up all the dir and suffix variables. ! +write(stdout,*) 'prim trimcheck' + + outdir = trimcheck(outdir) tmp_dir = outdir ! @@ -338,6 +341,7 @@ SUBROUTINE lr_readin ! FIXME:,if wfcdir is not present in input, wfc_dir is set to "undefined" ! instead of tmp_dir, because of the logic used in the rest of TDDFPT ! +write(stdout,*) 'second trimcheck' wfc_dir = trimcheck ( wfcdir ) ! IF (eels) THEN From 2b61bc1bbc12a306a0ab70e22167bc2290123e53 Mon Sep 17 00:00:00 2001 From: Pietro Delugas Date: Fri, 2 Aug 2019 18:20:53 +0000 Subject: [PATCH 93/95] fixing printout of ibrav in xml data file * The printout of ibrav in xml data file could be wrong if the initializing routine had to be called multiple times because of the missed iinitialization of optional pointers to NULL pointer. * to describe cases with ibrav < 0 the new boolean attribute use_alternative_axes has been added to the atomic_structure element in the xml schema, ibrav < 0 corresponds to bravais_index = abs(ibrav) and use_alternative_axes = .true. * more pointers to optional arguments are now initialized run time for the same reason --- CPV/src/cp_restart_new.f90 | 11 ++++--- Modules/qes_bcast_module.f90 | 3 ++ Modules/qes_init_module.f90 | 13 ++++++-- Modules/qes_read_module.f90 | 7 ++++ Modules/qes_reset_module.f90 | 1 + Modules/qes_types_module.f90 | 2 ++ Modules/qes_write_module.f90 | 1 + Modules/qexsd.f90 | 62 ++++++++++++++++++++++++++---------- Modules/qexsd_copy.f90 | 30 +++++++++++++++++ PW/src/pw_restart_new.f90 | 37 +++++++++++---------- 10 files changed, 125 insertions(+), 42 deletions(-) diff --git a/CPV/src/cp_restart_new.f90 b/CPV/src/cp_restart_new.f90 index 86db1208a5..ad353b0053 100644 --- a/CPV/src/cp_restart_new.f90 +++ b/CPV/src/cp_restart_new.f90 @@ -175,22 +175,23 @@ SUBROUTINE cp_writefile( ndw, ascii, nfi, simtime, acc, nk, xk, & TYPE(occupations_type) :: bands_occu TYPE(k_points_IBZ_type) :: k_points_IBZ CHARACTER(LEN=6), EXTERNAL :: int_to_char - TYPE (vdW_type),POINTER :: vdW_ =>NULL() - TYPE (dftU_type),POINTER :: dftU_ => NULL() - TYPE (hybrid_type),POINTER :: hybrid_ => NULL() + TYPE (vdW_type),POINTER :: vdW_ + TYPE (dftU_type),POINTER :: dftU_ + TYPE (hybrid_type),POINTER :: hybrid_ REAL(DP),ALLOCATABLE :: london_c6_(:) CHARACTER(LEN=3),ALLOCATABLE :: species_(:) REAL(DP),TARGET :: lond_rcut_, lond_s6_, ts_vdw_econv_thr_ REAL(DP),POINTER :: london_s6_pt, lonrcut_opt, ts_thr_opt INTEGER,POINTER :: nbnd_pt, nbnd_up_pt, nbnd_dw_pt CHARACTER(LEN=20),TARGET :: non_locc_, vdw_corr_ - CHARACTER(LEN=20),POINTER :: non_locc_opt=>NULL(), vdw_corr_opt=>NULL() - LOGICAL,POINTER :: ts_isol_opt => NULL() + CHARACTER(LEN=20),POINTER :: non_locc_opt, vdw_corr_opt + LOGICAL,POINTER :: ts_isol_opt LOGICAL,TARGET :: ts_vdW_isolated_ ! ! ... subroutine body ! NULLIFY( london_s6_pt, lonrcut_opt, ts_thr_opt, nbnd_pt, nbnd_up_pt, nbnd_dw_pt) + NULLIFY ( vdW_, dftU_, hybrid_, non_locc_opt, vdw_corr_opt, ts_isol_opt ) CALL start_clock('restart') ! IF( force_pairing ) & diff --git a/Modules/qes_bcast_module.f90 b/Modules/qes_bcast_module.f90 index 18d6f6abc3..724cf81ffe 100644 --- a/Modules/qes_bcast_module.f90 +++ b/Modules/qes_bcast_module.f90 @@ -531,6 +531,9 @@ SUBROUTINE qes_bcast_atomic_structure(obj, ionode_id, comm ) CALL mp_bcast(obj%bravais_index_ispresent, ionode_id, comm) IF (obj%bravais_index_ispresent) & CALL mp_bcast(obj%bravais_index, ionode_id, comm) + CALL mp_bcast(obj%alternative_axes_ispresent, ionode_id, comm) + IF (obj%alternative_axes_ispresent) & + CALL mp_bcast(obj%alternative_axes, ionode_id, comm) CALL mp_bcast(obj%atomic_positions_ispresent, ionode_id, comm) IF (obj%atomic_positions_ispresent) & CALL qes_bcast_atomic_positions(obj%atomic_positions, ionode_id, comm) diff --git a/Modules/qes_init_module.f90 b/Modules/qes_init_module.f90 index b36523b943..d242c4bce0 100644 --- a/Modules/qes_init_module.f90 +++ b/Modules/qes_init_module.f90 @@ -734,8 +734,8 @@ SUBROUTINE qes_init_species(obj, tagname, name, pseudo_file, mass, starting_magn END SUBROUTINE qes_init_species ! ! - SUBROUTINE qes_init_atomic_structure(obj, tagname, nat, cell, alat, bravais_index, atomic_positions,& - wyckoff_positions, crystal_positions) + SUBROUTINE qes_init_atomic_structure(obj, tagname, nat, cell, alat, bravais_index, alternative_axes,& + atomic_positions, wyckoff_positions, crystal_positions) ! IMPLICIT NONE ! @@ -744,6 +744,7 @@ SUBROUTINE qes_init_atomic_structure(obj, tagname, nat, cell, alat, bravais_inde INTEGER, INTENT(IN) :: nat REAL(DP), OPTIONAL, INTENT(IN) :: alat INTEGER, OPTIONAL, INTENT(IN) :: bravais_index + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: alternative_axes TYPE(atomic_positions_type),OPTIONAL,INTENT(IN) :: atomic_positions TYPE(wyckoff_positions_type),OPTIONAL,INTENT(IN) :: wyckoff_positions TYPE(atomic_positions_type),OPTIONAL,INTENT(IN) :: crystal_positions @@ -765,6 +766,12 @@ SUBROUTINE qes_init_atomic_structure(obj, tagname, nat, cell, alat, bravais_inde ELSE obj%bravais_index_ispresent = .FALSE. END IF + IF (PRESENT(alternative_axes)) THEN + obj%alternative_axes_ispresent = .TRUE. + obj%alternative_axes = alternative_axes + ELSE + obj%alternative_axes_ispresent = .FALSE. + END IF ! IF ( PRESENT(atomic_positions)) THEN obj%atomic_positions_ispresent = .TRUE. @@ -3291,4 +3298,4 @@ SUBROUTINE qes_init_scalarQuantity(obj, tagname, Units, scalarQuantity) END SUBROUTINE qes_init_scalarQuantity ! ! -END MODULE qes_init_module +END MODULE qes_init_module \ No newline at end of file diff --git a/Modules/qes_read_module.f90 b/Modules/qes_read_module.f90 index 46b01eb11e..59fb33222e 100644 --- a/Modules/qes_read_module.f90 +++ b/Modules/qes_read_module.f90 @@ -2507,6 +2507,13 @@ SUBROUTINE qes_read_atomic_structure(xml_node, obj, ierr ) obj%bravais_index_ispresent = .FALSE. END IF ! + IF (hasAttribute(xml_node, "alternative_axes")) THEN + CALL extractDataAttribute(xml_node, "alternative_axes", obj%alternative_axes) + obj%alternative_axes_ispresent = .TRUE. + ELSE + obj%alternative_axes_ispresent = .FALSE. + END IF + ! diff --git a/Modules/qes_reset_module.f90 b/Modules/qes_reset_module.f90 index 9433a8dcd8..a94d7aebbc 100644 --- a/Modules/qes_reset_module.f90 +++ b/Modules/qes_reset_module.f90 @@ -446,6 +446,7 @@ SUBROUTINE qes_reset_atomic_structure(obj) CALL qes_reset_cell(obj%cell) obj%alat_ispresent = .FALSE. obj%bravais_index_ispresent = .FALSE. + obj%alternative_axes_ispresent = .FALSE. ! END SUBROUTINE qes_reset_atomic_structure ! diff --git a/Modules/qes_types_module.f90 b/Modules/qes_types_module.f90 index c31a5dafa1..637db1a61b 100644 --- a/Modules/qes_types_module.f90 +++ b/Modules/qes_types_module.f90 @@ -1062,6 +1062,8 @@ MODULE qes_types_module LOGICAL :: alat_ispresent = .FALSE. INTEGER :: bravais_index LOGICAL :: bravais_index_ispresent = .FALSE. + CHARACTER(len=256) :: alternative_axes + LOGICAL :: alternative_axes_ispresent = .FALSE. LOGICAL :: atomic_positions_ispresent = .FALSE. TYPE(atomic_positions_type) :: atomic_positions LOGICAL :: wyckoff_positions_ispresent = .FALSE. diff --git a/Modules/qes_write_module.f90 b/Modules/qes_write_module.f90 index f89bcc38dc..e66b29f981 100644 --- a/Modules/qes_write_module.f90 +++ b/Modules/qes_write_module.f90 @@ -569,6 +569,7 @@ SUBROUTINE qes_write_atomic_structure(xp, obj) CALL xml_addAttribute(xp, 'nat', obj%nat ) IF (obj%alat_ispresent) CALL xml_addAttribute(xp, 'alat', obj%alat ) IF (obj%bravais_index_ispresent) CALL xml_addAttribute(xp, 'bravais_index', obj%bravais_index ) + IF (obj%alternative_axes_ispresent) CALL xml_addAttribute(xp, 'alternative_axes', TRIM(obj%alternative_axes) ) IF (obj%atomic_positions_ispresent) THEN CALL qes_write_atomic_positions (xp, obj%atomic_positions) END IF diff --git a/Modules/qexsd.f90 b/Modules/qexsd.f90 index f7e1dc8c48..d4733cae19 100644 --- a/Modules/qexsd.f90 +++ b/Modules/qexsd.f90 @@ -372,8 +372,9 @@ SUBROUTINE qexsd_init_convergence_info(obj, n_scf_steps, scf_has_converged, scf_ ! CHARACTER(27) :: subname="qexsd_init_convergence_info" TYPE(scf_conv_type) :: scf_conv - TYPE(opt_conv_type),POINTER :: opt_conv => NULL() + TYPE(opt_conv_type),POINTER :: opt_conv ! + NULLIFY(opt_conv) call qes_init (scf_conv, "scf_conv", scf_has_converged, n_scf_steps, scf_error) ! IF ( PRESENT(optimization_has_converged )) THEN @@ -425,13 +426,14 @@ SUBROUTINE qexsd_init_atomic_species(obj, nsp, atm, psfile, amass, starting_magn REAL(DP), OPTIONAL,TARGET, INTENT(IN) :: angle1(:),angle2(:) ! TYPE(species_type), ALLOCATABLE :: species(:) - REAL(DP),POINTER :: amass_ => NULL() - REAL(DP),POINTER :: start_mag_ => NULL() - REAL(DP),POINTER :: spin_teta => NULL() - REAL(DP),POINTER :: spin_phi => NULL() + REAL(DP),POINTER :: amass_ + REAL(DP),POINTER :: start_mag_ + REAL(DP),POINTER :: spin_teta + REAL(DP),POINTER :: spin_phi INTEGER :: i ALLOCATE(species(nsp)) + NULLIFY ( amass_, start_mag_, spin_teta, spin_phi) ! DO i = 1, nsp ! @@ -475,19 +477,42 @@ SUBROUTINE qexsd_init_atomic_structure(obj, nsp, atm, ityp, nat, tau, & REAL(DP), INTENT(IN) :: tau(3,*)! cartesian atomic positions, a.u. REAL(DP), INTENT(IN) :: alat REAL(DP), INTENT(IN) :: a1(:), a2(:), a3(:) - INTEGER,TARGET, INTENT(IN) :: ibrav + INTEGER, INTENT(IN) :: ibrav ! - INTEGER :: ia + INTEGER :: ia TYPE(atom_type), ALLOCATABLE :: atom(:) TYPE(cell_type) :: cell TYPE(atomic_positions_type) :: atomic_pos TYPE(wyckoff_positions_type) :: wyckoff_pos REAL(DP) :: new_alat - INTEGER,POINTER :: ibrav_ => NULL() + INTEGER,TARGET :: ibrav_tgt + INTEGER,POINTER :: ibrav_ptr + CHARACTER(LEN=256),POINTER :: use_alt_axes_ + CHARACTER(LEN=256),TARGET :: use_alt_axes ! ! atomic positions ! - IF ( ibrav .gt. 0 ) ibrav_ => ibrav + NULLIFY(use_alt_axes_) + IF ( ibrav .ne. 0 ) THEN + ibrav_tgt = abs(ibrav) + ibrav_ptr => ibrav_tgt + use_alt_axes_ => use_alt_axes + SELECT CASE(abs(ibrav)) + CASE(-3) + use_alt_axes="b:a-b+c:-c" + CASE(-5) + use_alt_axes="3fold-111" + CASE(-9) + use_alt_axes="-b:a:c" + CASE (91) + ibrav_tgt = 9 + use_alt_axes ="bcoA-type" + CASE(-12,-13) + use_alt_axes="unique-axis-b" + CASE default + NULLIFY (use_alt_axes_) + END SELECT + END IF ! ALLOCATE(atom(nat)) @@ -508,8 +533,8 @@ SUBROUTINE qexsd_init_atomic_structure(obj, nsp, atm, ityp, nat, tau, & ! ! global init ! - CALL qes_init (obj, "atomic_structure", nat=nat, alat=alat, atomic_positions=atomic_pos, cell=cell , & - bravais_index=ibrav_) + CALL qes_init (obj, "atomic_structure", NAT=nat, ALAT=alat, ATOMIC_POSITIONS=atomic_pos, CELL=cell , & + BRAVAIS_INDEX=ibrav_ptr, ALTERNATIVE_AXES = use_alt_axes_ ) ! ! cleanup ! @@ -539,15 +564,16 @@ SUBROUTINE qexsd_init_symmetries(obj, nsym, nrot, space_group, s, ft, sname, t_r TYPE(equivalent_atoms_type) :: equiv_atm TYPE(info_type) :: info TYPE(matrix_type) :: matrix - CHARACTER(LEN=15),POINTER :: classname => NULL() + CHARACTER(LEN=15),POINTER :: classname CHARACTER(LEN=256) :: la_info LOGICAL :: class_ispresent = .FALSE., time_reversal_ispresent = .FALSE. INTEGER :: i REAL(DP) :: mat_(3,3) LOGICAL :: true_=.TRUE., false_ = .FALSE. - LOGICAL,POINTER :: trev =>NULL() + LOGICAL,POINTER :: trev TARGET :: class_names, true_, false_ ALLOCATE(symm(nrot)) + NULLIFY( classname, trev) ! IF ( TRIM(verbosity) .EQ. 'high' .OR. TRIM(verbosity) .EQ. 'medium') class_ispresent= .TRUE. IF ( noncolin ) time_reversal_ispresent = .TRUE. @@ -665,8 +691,9 @@ SUBROUTINE qexsd_init_hybrid ( obj, dft_is_hybrid, nq1, nq2, nq3, ecutfock, exx_ LOGICAL,OPTIONAL,INTENT(IN) :: x_gamma_extrapolation ! TYPE (qpoint_grid_type),TARGET :: qpoint_grid - TYPE (qpoint_grid_type),POINTER :: qpoint_grid_opt => NULL() + TYPE (qpoint_grid_type),POINTER :: qpoint_grid_opt ! + NULLIFY ( qpoint_grid_opt) IF (.NOT. dft_is_hybrid) RETURN IF (PRESENT(nq1) .AND. PRESENT(nq2) .AND. PRESENT(nq3) ) THEN qpoint_grid_opt => qpoint_grid @@ -1020,7 +1047,7 @@ SUBROUTINE qexsd_init_band_structure(obj, lsda, noncolin, lspinorb, nelec, n_wfc LOGICAL :: n_wfc_at_ispresent = .TRUE. INTEGER :: ndim_ks_energies, ik INTEGER,TARGET :: nbnd_, nbnd_up_, nbnd_dw_ - INTEGER,POINTER :: nbnd_opt => NULL(), nbnd_up_opt => NULL(), nbnd_dw_opt => NULL() + INTEGER,POINTER :: nbnd_opt, nbnd_up_opt, nbnd_dw_opt TYPE(k_point_type) :: kp_obj TYPE(ks_energies_type),ALLOCATABLE :: ks_objs(:) TYPE (k_points_IBZ_type) :: starting_k_points_ @@ -1030,7 +1057,7 @@ SUBROUTINE qexsd_init_band_structure(obj, lsda, noncolin, lspinorb, nelec, n_wfc ! ndim_ks_energies=nks ! - + NULLIFY( nbnd_opt, nbnd_up_opt, nbnd_dw_opt) IF ( lsda ) THEN ndim_ks_energies=ndim_ks_energies/2 nbnd_up_opt => nbnd_up_ @@ -1402,13 +1429,14 @@ SUBROUTINE qexsd_init_berryPhaseOutput( obj, gpar, gvec, nppstr, nkort, xk, pdl_ TYPE ( atom_type ) :: atom_obj TYPE ( scalarQuantity_type ) :: pol_val INTEGER :: iat, istring, indstring - INTEGER,POINTER :: ispin => NULL() + INTEGER,POINTER :: ispin INTEGER, TARGET :: spin_val CHARACTER(10) :: mod_string LOGICAL :: spin_is = .FALSE. ! ALLOCATE (ion_pol_obj(nat)) ALLOCATE (str_pol_obj(nstring)) + NULLIFY(ispin) DO iat =1, nat WRITE(mod_string,'("(mod" ,I1,")")') mod_ion(iat) CALL qes_init (ion_phase,"phase", modulus = TRIM(mod_string), phase = pdl_ion(iat) ) diff --git a/Modules/qexsd_copy.f90 b/Modules/qexsd_copy.f90 index 1b8e0aebab..8332628e2b 100644 --- a/Modules/qexsd_copy.f90 +++ b/Modules/qexsd_copy.f90 @@ -150,6 +150,36 @@ SUBROUTINE qexsd_copy_atomic_structure (atomic_structure, nsp, atm, & alat = atomic_structure%alat IF ( atomic_structure%bravais_index_ispresent ) THEN ibrav = atomic_structure%bravais_index + IF (atomic_structure%alternative_axes_ispresent ) THEN + SELECT CASE(ibrav) + CASE(3) + IF (TRIM(atomic_structure%alternative_axes)=="b:a-b+c:-c") THEN + ibrav = -ibrav + ELSE + CALL errore("qexsd_copy_atomic_structure:","alternative axes not recognised", 1) + END IF + CASE(5) + IF (TRIM(atomic_structure%alternative_axes)=="3fold-111") THEN + ibrav = -ibrav + ELSE + CALL errore("qexsd_copy_atomic_structure:","alternative axes not recognised", 1) + END IF + CASE(9) + IF (TRIM(atomic_structure%alternative_axes)=="-b:a:c") THEN + ibrav = -ibrav + ELSE IF( TRIM(atomic_structure%alternative_axes)=="bcoA-type") THEN + ibrav = 91 + ELSE + CALL errore("qexsd_copy_atomic_structure:","alternative axes not recognised", 1) + END IF + CASE(13,14) + IF (TRIM(atomic_structure%alternative_axes)=="unique-axis-b") THEN + ibrav = -ibrav + ELSE + CALL errore("qexsd_copy_atomic_structure:","alternativ axes not recognised", 1) + END IF + END SELECT + END IF ELSE ibrav = 0 END IF diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 08b37153f3..3a8596bb5c 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -157,22 +157,22 @@ SUBROUTINE pw_write_schema( only_init, wf_collect ) INTEGER :: n_opt_steps, n_scf_steps_, h_band REAL(DP),TARGET :: h_energy TYPE(gateInfo_type),TARGET :: gate_info_temp - TYPE(gateInfo_type),POINTER :: gate_info_ptr => NULL() + TYPE(gateInfo_type),POINTER :: gate_info_ptr TYPE(dipoleOutput_type),TARGET :: dipol_obj - TYPE(dipoleOutput_type),POINTER :: dipol_ptr => NULL() - TYPE(BerryPhaseOutput_type), POINTER :: bp_obj_ptr => NULL() - TYPE(hybrid_type), POINTER :: hybrid_obj => NULL() - TYPE(vdW_type), POINTER :: vdw_obj => NULL() - TYPE(dftU_type), POINTER :: dftU_obj => NULL() + TYPE(dipoleOutput_type),POINTER :: dipol_ptr + TYPE(BerryPhaseOutput_type), POINTER :: bp_obj_ptr + TYPE(hybrid_type), POINTER :: hybrid_obj + TYPE(vdW_type), POINTER :: vdw_obj + TYPE(dftU_type), POINTER :: dftU_obj REAL(DP), TARGET :: lumo_tmp, ef_targ, dispersion_energy_term - REAL(DP), POINTER :: lumo_energy => NULL(), ef_point => NULL() + REAL(DP), POINTER :: lumo_energy, ef_point REAL(DP), ALLOCATABLE :: ef_updw(:) ! ! ! TYPE(output_type) :: output REAL(DP),POINTER :: degauss_, demet_, efield_corr, potstat_corr, gatefield_corr - LOGICAL, POINTER :: optimization_has_converged => NULL() + LOGICAL, POINTER :: optimization_has_converged LOGICAL, TARGET :: conv_opt LOGICAL :: scf_has_converged INTEGER :: itemp = 1 @@ -182,20 +182,23 @@ SUBROUTINE pw_write_schema( only_init, wf_collect ) CHARACTER(LEN=20),TARGET :: dft_nonlocc_ INTEGER,TARGET :: dftd3_version_ CHARACTER(LEN=20),TARGET :: vdw_corr_, pbc_label - CHARACTER(LEN=20),POINTER :: non_local_term_pt =>NULL(), vdw_corr_pt=>NULL() + CHARACTER(LEN=20),POINTER :: non_local_term_pt, vdw_corr_pt REAL(DP),TARGET :: temp(20), lond_rcut_, lond_s6_, ts_vdw_econv_thr_, xdm_a1_, xdm_a2_, ectuvcut_,& scr_par_, loc_thr_ - REAL(DP),POINTER :: vdw_term_pt =>NULL(), ts_thr_pt=>NULL(), london_s6_pt=>NULL(),& - london_rcut_pt=>NULL(), xdm_a1_pt=>NULL(), xdm_a2_pt=>NULL(), & - ts_vdw_econv_thr_pt=>NULL(), ectuvcut_opt=>NULL(), scr_par_opt=>NULL(), & - loc_thr_p => NULL(), h_energy_ptr => NULL() + REAL(DP),POINTER :: vdw_term_pt, ts_thr_pt, london_s6_pt, london_rcut_pt, xdm_a1_pt, xdm_a2_pt, & + ts_vdw_econv_thr_pt, ectuvcut_opt, scr_par_opt, loc_thr_p, h_energy_ptr LOGICAL,TARGET :: dftd3_threebody_, ts_vdw_isolated_ - LOGICAL,POINTER :: ts_isol_pt=>NULL(), dftd3_threebody_pt=>NULL(), ts_vdw_isolated_pt =>NULL() - INTEGER,POINTER :: dftd3_version_pt => NULL() + LOGICAL,POINTER :: ts_isol_pt, dftd3_threebody_pt, ts_vdw_isolated_pt + INTEGER,POINTER :: dftd3_version_pt TYPE(smearing_type),TARGET :: smear_obj - TYPE(smearing_type),POINTER:: smear_obj_ptr => NULL() + TYPE(smearing_type),POINTER:: smear_obj_ptr - NULLIFY( degauss_, demet_, efield_corr, potstat_corr, gatefield_corr ) + NULLIFY( degauss_, demet_, efield_corr, potstat_corr, gatefield_corr) + NULLIFY( gate_info_ptr, dipol_ptr, bp_obj_ptr, hybrid_obj, vdw_obj, dftU_obj, lumo_energy, ef_point) + NULLIFY ( optimization_has_converged, non_local_term_pt, vdw_corr_pt, vdw_term_pt, ts_thr_pt, london_s6_pt, & + xdm_a1_pt, xdm_a2_pt, ts_vdw_econv_thr_pt, ts_isol_pt, dftd3_threebody_pt, ts_vdw_isolated_pt, & + dftd3_version_pt ) + NULLIFY ( ectuvcut_opt, scr_par_opt, loc_thr_p, h_energy_ptr, smear_obj_ptr) ! ! Global PW dimensions need to be properly computed, reducing across MPI tasks From 95681ee19ee6455fadfcbee05d1897969889aecf Mon Sep 17 00:00:00 2001 From: Paolo Giannozzi Date: Sat, 3 Aug 2019 08:37:46 +0200 Subject: [PATCH 94/95] Misc fixes: - some compilers don't like to pass pointers that are neither set nor explicitly nullified - configure updated to reflect the latest changes --- Modules/qexsd.f90 | 7 +++--- PW/src/setup.f90 | 2 +- install/configure | 58 +++++++++++++++++++++++------------------------ 3 files changed, 34 insertions(+), 33 deletions(-) diff --git a/Modules/qexsd.f90 b/Modules/qexsd.f90 index d4733cae19..cd28163227 100644 --- a/Modules/qexsd.f90 +++ b/Modules/qexsd.f90 @@ -492,7 +492,7 @@ SUBROUTINE qexsd_init_atomic_structure(obj, nsp, atm, ityp, nat, tau, & ! ! atomic positions ! - NULLIFY(use_alt_axes_) + NULLIFY(use_alt_axes_, ibrav_ptr) IF ( ibrav .ne. 0 ) THEN ibrav_tgt = abs(ibrav) ibrav_ptr => ibrav_tgt @@ -533,8 +533,9 @@ SUBROUTINE qexsd_init_atomic_structure(obj, nsp, atm, ityp, nat, tau, & ! ! global init ! - CALL qes_init (obj, "atomic_structure", NAT=nat, ALAT=alat, ATOMIC_POSITIONS=atomic_pos, CELL=cell , & - BRAVAIS_INDEX=ibrav_ptr, ALTERNATIVE_AXES = use_alt_axes_ ) + CALL qes_init (obj, "atomic_structure", NAT=nat, ALAT=alat, & + ATOMIC_POSITIONS=atomic_pos, CELL=cell , & + BRAVAIS_INDEX=ibrav_ptr, ALTERNATIVE_AXES = use_alt_axes_ ) ! ! cleanup ! diff --git a/PW/src/setup.f90 b/PW/src/setup.f90 index 3bb48c4f6a..852cf2f24a 100644 --- a/PW/src/setup.f90 +++ b/PW/src/setup.f90 @@ -79,7 +79,7 @@ SUBROUTINE setup() USE pw_restart_new, ONLY : pw_read_schema USE qexsd_copy, ONLY : qexsd_copy_efermi USE qes_libs_module, ONLY : qes_reset - USE qes_types_module, ONLY : output_type, parallel_info_type, general_info_type + USE qes_types_module, ONLY : output_type USE exx, ONLY : ecutfock, nbndproj USE exx_base, ONLY : exx_grid_init, exx_mp_init, exx_div_check USE funct, ONLY : dft_is_meta, dft_is_hybrid, dft_is_gradient diff --git a/install/configure b/install/configure index 4182859d30..1a20ac6f6d 100755 --- a/install/configure +++ b/install/configure @@ -4441,7 +4441,7 @@ mpif90=$FC # check which compiler does mpif90 wrap case "$arch" in - ia32 | ia64 | x86_64 | mac686 ) + * ) echo $ECHO_N "checking version of $mpif90... $ECHO_C" ifort_version=`$mpif90 -V 2>&1 | grep "Intel(R)"` pgf_version=`$mpif90 -V 2>&1 | grep "^pgf"` @@ -5356,19 +5356,6 @@ x86_64:nagfor* ) try_dflags="$try_dflags -D__NAG" have_cpp=0 ;; -ia32:pgf* | ia64:pgf* | x86_64:pgf* ) - try_fflags_nomain="-Mnomain" - try_fflags="-fast" - try_fflags_openmp="-mp" - try_f90flags="-fast -Mcache_align -Mpreprocess -Mlarge_arrays" - try_foxflags="-fast -Mcache_align -Mpreprocess -Mlarge_arrays" - try_fflags_noopt="-O0" - try_ldflags="" - try_ldflags_openmp="-mp" - try_ldflags_static="-Bstatic" - try_dflags="$try_dflags -D__PGI" - have_cpp=1 - ;; ia32:path* | ia64:path* | x86_64:path* ) try_fflags="-march=auto -O2" try_f90flags="\$(FFLAGS)" @@ -5377,21 +5364,6 @@ ia32:path* | ia64:path* | x86_64:path* ) try_ldflags_static="-static" have_cpp=0 ;; -*:*gfortran ) - try_fflags="-O3 -g" - if test "$use_debug" -eq 1; then - try_fflags="-O3 -g -Wall -fbounds-check -frange-check -finit-integer=987654321 -finit-real=nan -finit-logical=true -finit-character=64" - fi - if test "$use_pedantic" -eq 1; then - try_fflags="-O2 -g -pedantic -Wall -Wextra -Wconversion -fimplicit-none -fbacktrace -ffree-line-length-0 -fcheck=all" - fi - try_fflags_openmp="-fopenmp" - try_f90flags="\$(FFLAGS) -x f95-cpp-input" - try_fflags_noopt="-O0 -g" - try_ldflags="-g" - try_ldflags_openmp="-pthread -fopenmp" - try_ldflags_static="-static" - ;; crayxt*:cray* ) try_fflags_nomain="" #NOTE: by default OpenMP is always ON (see crayftn man page) @@ -5495,6 +5467,34 @@ ppc64-bgq:*xlf* ) pre_fdflags="-WF," xlf_flags=1 ;; +*:pgf* ) + try_fflags_nomain="-Mnomain" + try_fflags="-fast" + try_fflags_openmp="-mp" + try_f90flags="-fast -Mcache_align -Mpreprocess -Mlarge_arrays" + try_foxflags="-fast -Mcache_align -Mpreprocess -Mlarge_arrays" + try_fflags_noopt="-O0" + try_ldflags="" + try_ldflags_openmp="-mp" + try_ldflags_static="-Bstatic" + try_dflags="$try_dflags -D__PGI" + have_cpp=1 + ;; +*:*gfortran ) + try_fflags="-O3 -g" + if test "$use_debug" -eq 1; then + try_fflags="-O3 -g -Wall -fbounds-check -frange-check -finit-integer=987654321 -finit-real=nan -finit-logical=true -finit-character=64" + fi + if test "$use_pedantic" -eq 1; then + try_fflags="-O2 -g -pedantic -Wall -Wextra -Wconversion -fimplicit-none -fbacktrace -ffree-line-length-0 -fcheck=all" + fi + try_fflags_openmp="-fopenmp" + try_f90flags="\$(FFLAGS) -x f95-cpp-input" + try_fflags_noopt="-O0 -g" + try_ldflags="-g" + try_ldflags_openmp="-pthread -fopenmp" + try_ldflags_static="-static" + ;; * ) # unknown, try these From 48ddc7c47e00c8f372331f0db5a6ccb38a189256 Mon Sep 17 00:00:00 2001 From: Oscar Baseggio Date: Mon, 5 Aug 2019 09:36:46 +0200 Subject: [PATCH 95/95] clean TDDFPT/src/lr_readin.f90 change name: ph_lanczos_iter.f90 -> LR_Modules/lanczos_pseudohermitian.f90 bo_lanczos_iter.f90 -> LR_Modules/lanczos_nonhermitian.f90 --- LR_Modules/Makefile | 4 +-- ...czos_iter.f90 => lanczos_nonhermitian.f90} | 4 +-- ...s_iter.f90 => lanczos_pseudohermitian.f90} | 4 +-- TDDFPT/src/lr_lanczos.f90 | 32 +++++++++---------- TDDFPT/src/lr_readin.f90 | 4 --- 5 files changed, 22 insertions(+), 26 deletions(-) rename LR_Modules/{bo_lanczos_iter.f90 => lanczos_nonhermitian.f90} (96%) rename LR_Modules/{ph_lanczos_iter.f90 => lanczos_pseudohermitian.f90} (95%) diff --git a/LR_Modules/Makefile b/LR_Modules/Makefile index 8e91253eda..937742e302 100644 --- a/LR_Modules/Makefile +++ b/LR_Modules/Makefile @@ -55,8 +55,8 @@ mode_group.o \ mix_pot.o \ lrcom.o \ lr_dot.o \ -ph_lanczos_iter.o \ -bo_lanczos_iter.o +lanczos_pseudohermitian.o \ +lanczos_nonhermitian.o TLDEPS=mods pwlibs diff --git a/LR_Modules/bo_lanczos_iter.f90 b/LR_Modules/lanczos_nonhermitian.f90 similarity index 96% rename from LR_Modules/bo_lanczos_iter.f90 rename to LR_Modules/lanczos_nonhermitian.f90 index 98cb6939fb..8687829345 100644 --- a/LR_Modules/bo_lanczos_iter.f90 +++ b/LR_Modules/lanczos_nonhermitian.f90 @@ -1,4 +1,4 @@ -subroutine bo_lanczos_iter(j, npwx_npol, nbnd_occ, nksq, qj, Aqj, Sqj, qjold, n_ipol, u, alpha, beta, gamma, zeta) +subroutine lanczos_nonhermitian(j, npwx_npol, nbnd_occ, nksq, qj, Aqj, Sqj, qjold, n_ipol, u, alpha, beta, gamma, zeta) ! !! Bi-Orthogonal Lanczos algorithm !! @@ -119,4 +119,4 @@ subroutine bo_lanczos_iter(j, npwx_npol, nbnd_occ, nksq, qj, Aqj, Sqj, qjold, n_ CALL zcopy(size_evc,qj(1,1,1,2),1,qjold(1,1,1,2),1) ! qjold = qj CALL zcopy(size_evc,Aqj(1,1,1,2),1,qj(1,1,1,2),1) ! qj = Aqj ! -end subroutine bo_lanczos_iter +end subroutine lanczos_nonhermitian diff --git a/LR_Modules/ph_lanczos_iter.f90 b/LR_Modules/lanczos_pseudohermitian.f90 similarity index 95% rename from LR_Modules/ph_lanczos_iter.f90 rename to LR_Modules/lanczos_pseudohermitian.f90 index 3d1907229a..b083757fb8 100644 --- a/LR_Modules/ph_lanczos_iter.f90 +++ b/LR_Modules/lanczos_pseudohermitian.f90 @@ -1,4 +1,4 @@ -subroutine ph_lanczos_iter(j, npwx_npol, nbnd_occ, nksq, qj, Aqj, SAqj, qjold, n_ipol, u, alpha, beta, gamma, zeta) +subroutine lanczos_pseudohermitian(j, npwx_npol, nbnd_occ, nksq, qj, Aqj, SAqj, qjold, n_ipol, u, alpha, beta, gamma, zeta) ! !! Pseudo-Hermitian Lanczos algorithm !! @@ -113,4 +113,4 @@ subroutine ph_lanczos_iter(j, npwx_npol, nbnd_occ, nksq, qj, Aqj, SAqj, qjold, n CALL zcopy(size_evc,qj(1,1,1),1,qjold(1,1,1),1) ! qjold = qj CALL zcopy(size_evc,Aqj(1,1,1),1,qj(1,1,1),1) ! qj = Aqj ! -end subroutine ph_lanczos_iter +end subroutine lanczos_pseudohermitian diff --git a/TDDFPT/src/lr_lanczos.f90 b/TDDFPT/src/lr_lanczos.f90 index 86102d374c..d7b354b2b6 100644 --- a/TDDFPT/src/lr_lanczos.f90 +++ b/TDDFPT/src/lr_lanczos.f90 @@ -164,27 +164,27 @@ SUBROUTINE one_lanczos_step() ! IF (pseudo_hermitian) THEN IF (eels) THEN - CALL ph_lanczos_iter(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& - &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1_new(:,:,:), & - &evc1_old(:,:,:,1), n_ipol, d0psi2, alpha, beta, & - &gamma, zeta) + CALL lanczos_pseudohermitian(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& + &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1_new(:,:,:), & + &evc1_old(:,:,:,1), n_ipol, d0psi2, alpha, beta, & + &gamma, zeta) ELSE - CALL ph_lanczos_iter(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& - &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1_new(:,:,:), & - &evc1_old(:,:,:,1), n_ipol, d0psi(:,:,:,:), alpha, beta, & - &gamma, zeta) + CALL lanczos_pseudohermitian(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& + &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1_new(:,:,:), & + &evc1_old(:,:,:,1), n_ipol, d0psi(:,:,:,:), alpha, beta, & + &gamma, zeta) ENDIF ELSE IF (eels) THEN - CALL bo_lanczos_iter(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& - &evc1(:,:,:,:), evc1_new(:,:,:,:), sevc1(:,:,:), & - &evc1_old(:,:,:,1), n_ipol, d0psi2, alpha, beta, & - &gamma, zeta) + CALL lanczos_nonhermitian(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& + &evc1(:,:,:,:), evc1_new(:,:,:,:), sevc1(:,:,:), & + &evc1_old(:,:,:,1), n_ipol, d0psi2, alpha, beta, & + &gamma, zeta) ELSE - CALL bo_lanczos_iter(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& - &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1(:,:,:), & - &evc1_old(:,:,:,1), n_ipol, d0psi, alpha, beta, & - &gamma, zeta) + CALL lanczos_nonhermitian(LR_iteration,size(evc1,1), size(evc1,2), size(evc1,3),& + &evc1(:,:,:,1), evc1_new(:,:,:,1), sevc1(:,:,:), & + &evc1_old(:,:,:,1), n_ipol, d0psi, alpha, beta, & + &gamma, zeta) ENDIF ENDIF ! diff --git a/TDDFPT/src/lr_readin.f90 b/TDDFPT/src/lr_readin.f90 index f829caf614..861c3be1ef 100644 --- a/TDDFPT/src/lr_readin.f90 +++ b/TDDFPT/src/lr_readin.f90 @@ -197,9 +197,6 @@ SUBROUTINE lr_readin ! ! Set-up all the dir and suffix variables. ! -write(stdout,*) 'prim trimcheck' - - outdir = trimcheck(outdir) tmp_dir = outdir ! @@ -341,7 +338,6 @@ SUBROUTINE lr_readin ! FIXME:,if wfcdir is not present in input, wfc_dir is set to "undefined" ! instead of tmp_dir, because of the logic used in the rest of TDDFPT ! -write(stdout,*) 'second trimcheck' wfc_dir = trimcheck ( wfcdir ) ! IF (eels) THEN