! ! Copyright (C) 2004-2005 PWSCF 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 el_config & ( config, rel, lsd, all_elec, nwf, el, nn, ll, oc, isw, jj) !--------------------------------------------------------------- ! ! read electronic configuration from string "config" ! example: config = '[Ar] 3d10 4s2 4p2.5' ! Replicated wavefunctions are allowed and correspond to: ! spin-up, spin-down for lsd; ! j=l-1/2, j=j+1/2 for relativistic calculation and l > 0 ; ! error in all other cases ! See file INPUT_LD1 for full syntax ! use kinds, only: dp use ld1_parameters implicit none ! input: electronic configuration character(len=*), intent(in):: config logical, intent(in) :: all_elec integer, intent(in) :: lsd, rel ! output: atomic states character(len=2), intent(out) :: el(nwfx) integer, intent(out) :: nwf, nn(nwfx), ll(nwfx), isw(nwfx) real(DP), intent(out) :: oc(nwfx), jj(nwfx) ! local variables logical :: toomany integer :: i, n, l, len, n0, first, start(nwfx), finish(nwfx) character :: occup*10, core*2, prev*1, curr*1 character(len=1), external :: capital ! core states character(len=2) :: elc(15) integer :: nwfc, nnc(15), llc(15) real(DP) :: occ(15) data elc/'1S','2S','2P','3S','3P','4S','4P','3D','5S','5P','4D', & & '6S','6P','5D','4F'/ data nnc/1 ,2 ,2 ,3 ,3 ,4 ,4 ,3 ,5 ,5 ,4 ,6 ,6 ,5 ,4 / data llc/0, 0, 1, 0, 1, 0, 1, 2, 0, 1, 2, 0, 1, 2, 3/ data occ/2.0,2.0,6.0,2.0,6.0,2.0,6.0,10.0,2.0,6.0,10.0,2.0,6.0,10.0,14.0/ ! ! len is the length of the string, excluding trailing blanks ! len=len_trim(config) if (len == 0) call errore('el_config','empty string',1) ! ! first is the position of the first nonblank character in the string ! do first=1,len if (config(first:first) /= ' ') go to 10 end do 10 continue ! ! find core wavefunctions (if any) ! if (all_elec .and. & & config(first :first ) == '[' .and. & & config(first+3:first+3) == ']') then core = config(first+1:first+2) if (core == 'He'.or.core == 'he'.or.core == 'HE') then nwfc =1 else if (core == 'Ne'.or.core == 'ne'.or.core == 'NE') then nwfc =3 else if (core == 'Ar'.or.core == 'ar'.or.core == 'AR') then nwfc =5 else if (core == 'Kr'.or.core == 'kr'.or.core == 'KR') then nwfc =8 else if (core == 'Xe'.or.core == 'xe'.or.core == 'XE') then nwfc =11 else if (core == 'Rn'.or.core == 'rn'.or.core == 'RN') then nwfc =15 else call errore('el_config','wrong core: '//core,1) end if do n=1,nwfc el(n)=elc(n) ll(n)=llc(n) nn(n)=nnc(n) oc(n)=occ(n) isw(n)=1 end do ! find first nonblank character after core term do i=first+4,len if (config(i:i) /= ' ') go to 20 end do 20 first=i else nwfc=0 first=1 end if if (first >= len) then nwf=nwfc return endif ! ! now count and find the various terms "NLf" (eg: 1s2.0) ! N=main quantum number, L=angular quantum number, f=occupancy ! nwf=nwfc+1 if (nwf > nwfx) call errore('config','too many states',nwf) start(nwf)=first do i=first+1,len prev=config(i-1:i-1) curr=config(i :i ) if ((curr == ' ' .or. curr == ',') .and. & & prev /= ' ' .and. prev /= ',') then finish(nwf)=i-1 nwf=nwf+1 else if (curr /= ' ' .and. curr /= ',' .and. & & (prev == ' ' .or. prev == ',')) then start(nwf)=i endif enddo finish(nwf)=len ! ! extract N,L,f from "NLf" terms ! ! do n=nwfc+1,nwf prev = config(start(n):start(n)) read(prev,*) nn(n) if (nn(n) <= 0 .or. nn(n) > 7) & & call errore('el_config','wrong main quantum number',n) curr = capital(config(start(n)+1:start(n)+1)) ll(n)=-1 if (curr == 'S') ll(n)=0 if (curr == 'P') ll(n)=1 if (curr == 'D') ll(n)=2 if (curr == 'F') ll(n)=3 if (ll(n) == -1) call errore('el_config','l not found:'//curr,n) if (ll(n).ge.nn(n)) call errore('el_config', & & 'main/angular quantum number mismatch',n) el(n)=prev//curr if (start(n)+2 > finish(n)) & & call errore('el_config','no occupancy field?',n) occup = config(start(n)+2:finish(n)) read(occup,*) oc(n) if (oc(n) > 2*(2*ll(n)+1)) & call errore('el_config','wrong occupancy:'//occup,n) enddo ! ! check same labels corresponding to different spin or j value ! do n=nwfc+1,nwf isw(n)=1 jj(n) =0.0_dp toomany = .false. do i=1,n-1 if (el(i) == el(n)) then ! if (rel == 2) then ! ! relativistic case: j=l-1/2, j=l+1/2 ! toomany = (jj(i) > 0.0_dp) .or. ll(n) == 0 ! jj(i)=ll(i)-0.5_dp jj(n)=ll(n)+0.5_dp if ( oc(n) > (2.0_dp*jj(n)+1.0_dp) ) & call errore('el_config','occupation wrong',n) if ( oc(i) > (2.0_dp*jj(i)+1.0_dp) ) & call errore('el_config','occupation wrong',i) else if (lsd == 1) then ! ! lsda case: spin up, spin down ! toomany = (isw(i) > 1) ! isw(n)=2 else ! ! lda case: this shouldn't happen ! toomany = .true. end if endif enddo ! if (toomany) call errore('el_config', & 'wavefunction '//el(n)//' found too many times',n) ! end do ! ! pseudopotentials: N quantum number .ne. wavefunction label ! we find the lowest N for each L and reassign N as it ! if (.not.all_elec) then do l=0,3 n0=1000 do n=1,nwf if (ll(n) == l) n0=min(n0,nn(n)) end do do n=1,nwf if (ll(n) == l) nn(n)=nn(n)-n0+1+l end do end do endif return end subroutine el_config ! !--------------------------------------------------------------- subroutine read_config(rel, lsd, nwf, el, nn, ll, oc, isw, jj) !--------------------------------------------------------------- ! ! read electronic configuration from input. Syntax: ! nwf ! followed by nwf cards ! label N L occ (example: 4S 4 0 2.0) for lda ! or ! label N L occ spin (example: 4S 4 0 1.0 1) for lsda ! or ! label N L occ j (example: 4P 4 1 1.0 1.5) for full relativistic ! See file INPUT_LD1 for full syntax ! use kinds, only: dp use ld1_parameters, only: nwfx implicit none ! input integer :: rel, lsd ! output: atomic states character(len=2) :: el(nwfx) integer :: nwf, nn(nwfx), ll(nwfx), isw(nwfx) real(DP) :: oc(nwfx), jj(nwfx) ! local variables integer :: ios, n, ncheck character (len=2) :: label character (len=1), external :: capital ! ! read(5,*,err=200,iostat=ios) nwf 200 call errore('read_config','reading nwf ',abs(ios)) if (nwf <= 0) call errore('read_config','nwf is wrong',1) if (nwf > nwfx) call errore('read_config','too many wfcs',1) ! ! read the occupation of the states ! do n=1,nwf if (rel < 2) then jj(n) = 0.0_dp if (lsd == 0) then read(5,*,err=20,end=20,iostat=ios) & el(n), nn(n), ll(n), oc(n) isw(n)=1 20 call errore('read_config','reading orbital (lda)',abs(ios)) else read(5,*,err=21,end=21,iostat=ios) & el(n), nn(n), ll(n), oc(n), isw(n) 21 call errore('read_config','reading orbital (lsd)',abs(ios)) if(isw(n) > 2 .or. isw(n) < 1) & call errore('read_config','spin variable wrong ',n) endif else read(5,*,err=22,end=22,iostat=ios) & el(n), nn(n), ll(n), oc(n), jj(n) isw(n)=1 if ((abs(ll(n)+0.5_dp-jj(n)) > 1.e-3_dp) .and. & (abs(ll(n)-0.5_dp-jj(n)) > 1.e-3_dp) .and. abs(jj(n)) > 1.e-3_dp) & call errore('read_config','jj wrong',n) if (oc(n) > (2.0_dp*jj(n)+1.0_dp) .and. abs(jj(n)) > 1e-3_dp) & call errore('read_config','occupations wrong',n) 22 call errore('read_config','reading orbital (rel)',abs(ios)) endif ! ! Check: no two same wavefunctions ! do ncheck=1,n-1 if ( el(ncheck) == el(n) .and. isw(ncheck) == isw(n) .and. & jj(ncheck) == jj(n) ) then call errore('read_config', & 'same wavefunction '//el(n)//' appears twice',n) endif enddo ! ! More sanity checks ! write(label,'(a2)') el(n) read (label,'(i1)') ncheck if (ncheck /= nn(n) .or. & capital(label(2:2)) == 'S' .and. ll(n) /= 0 .or. & capital(label(2:2)) == 'P' .and. ll(n) /= 1 .or. & capital(label(2:2)) == 'D' .and. ll(n) /= 2 .or. & capital(label(2:2)) == 'F' .and. ll(n) /= 3 .or. & oc(n) > 2.0_dp*(2*ll(n)+1) .or. nn(n) < ll(n)+1 ) & call errore('read_config',label//' wrong?',n) enddo ! return end subroutine read_config ! !--------------------------------------------------------------- subroutine read_psconfig (rel, lsd, nwfs, els, nns, lls, ocs, & isws, jjs, enls, rcut, rcutus ) !--------------------------------------------------------------- ! read pseudostates and pseudization information from input ! See file INPUT_LD1 for full syntax ! use kinds, only: dp use ld1_parameters, only: nwfsx implicit none ! input integer :: rel, lsd ! output: atomic states character(len=2) :: els(nwfsx) integer :: nwfs, nns(nwfsx), lls(nwfsx), isws(nwfsx) real(DP) :: ocs(nwfsx), jjs(nwfsx), enls(nwfsx), & rcut(nwfsx), rcutus(nwfsx) ! local variables integer :: ios, n character (len=2) :: label character (len=1), external :: capital read(5,*,err=600,iostat=ios) nwfs 600 call errore('read_psconfig','reading number of pseudo wavefunctions (nwfs)',abs(ios)) if (nwfs <= 0 .or. nwfs > nwfsx) & call errore('read_psconfig','number of pseudo wavefunctions is wrong',1) do n=1,nwfs if (rel < 2) then if (lsd == 1) then read(5,*,err=30,end=30,iostat=ios) & els(n), nns(n), lls(n), ocs(n), enls(n), & rcut(n), rcutus(n), isws(n) if (isws(n) > 2 .or. isws(n) < 1) & call errore('read_psconfig', 'spin variable wrong',n) if (ocs(n) > (2.0_dp*lls(n)+1.0_dp)) & call errore('read_psconfig','occupations (ls) wrong',n) else read(5,*,err=30,end=30,iostat=ios) & els(n), nns(n), lls(n), ocs(n), enls(n), & rcut(n), rcutus(n) isws(n)=1 if (ocs(n) > 2.0_dp*(2.0_dp*lls(n)+1.0_dp)) & call errore('read_psconfig','occupations (l) wrong',n) end if jjs(n)=0.0_dp else read(5,*,err=30,end=30,iostat=ios) & els(n), nns(n), lls(n), ocs(n), enls(n), & rcut(n), rcutus(n), jjs(n) isws(n)=1 if ((abs(lls(n)+0.5_dp-jjs(n)) > 1.e-3_dp).and. & (abs(lls(n)-0.5_dp-jjs(n)) > 1.e-3_dp).and. abs(jjs(n)) > 1.e-3_dp) & call errore('read_psconfig', 'jjs wrong',n) if (ocs(n) > (2.0_dp*jjs(n)+1.0_dp).and. abs(jjs(n)) > 1.e-3_dp) & call errore('read_psconfig','occupations (j) wrong',n) endif write(label,'(a2)') els(n) if ( capital(label(2:2)) == 'S'.and.lls(n) /= 0.or. & capital(label(2:2)) == 'P'.and.lls(n) /= 1.or. & capital(label(2:2)) == 'D'.and.lls(n) /= 2.or. & capital(label(2:2)) == 'F'.and.lls(n) /= 3.or. & ocs(n) > 2*(2*lls(n)+1).or. & nns(n) < lls(n)+1 ) & call errore('read_psconfig','ps-label'//' wrong?',n) if (rcut(n) > rcutus(n)) & call errore('read_psconfig','rcut or rcutus is wrong',1) enddo 30 call errore('read_psconfig','reading pseudo wavefunctions configuration',abs(ios)) ! return end subroutine read_psconfig !------------------------------------------------------------------------