From 5e1a01dd69cffbfc9243ed75df076bf347d8639e Mon Sep 17 00:00:00 2001 From: ballabio Date: Thu, 2 Sep 2004 15:48:23 +0000 Subject: [PATCH] replicated code caused problems with dependencies, fixed [Gerardo] git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@1215 c92efa57-630b-4861-b058-cf58834340f0 --- upftools/Makefile | 14 +- upftools/fpmd2upf.f90 | 440 ------------------------------------------ 2 files changed, 2 insertions(+), 452 deletions(-) diff --git a/upftools/Makefile b/upftools/Makefile index 7e6922741..0b632ec14 100644 --- a/upftools/Makefile +++ b/upftools/Makefile @@ -31,8 +31,8 @@ cpmd2upf.x : cpmd2upf.o $(OBJS) nclib.o oldcp2upf.x : oldcp2upf.o $(OBJS) nclib.o $(LD) -o $@ oldcp2upf.o nclib.o write_upf.o $(LDFLAGS) -fpmd2upf.x : fpmd2upf.o - $(LD) -o $@ fpmd2upf.o $(MODS) $(LDFLAGS) +fpmd2upf.x : fpmd2upf.o $(OBJS) + $(LD) -o $@ fpmd2upf.o $(OBJS) $(MODS) $(LDFLAGS) read_upf.x : $(LD) -o $@ read_upf.o $(LDFLAGS) @@ -40,14 +40,4 @@ read_upf.x : clean : - /bin/rm -f *.x *.o *~ *.F90 *.mod *.d *.i work.pc -any2upf.o: $(OBJS) -cpmd2upf.o: $(OBJS) -fhi2upf.o: $(OBJS) -ncpp2upf.o: $(OBJS) -oldcp2upf.o: $(OBJS) -rrkj2upf.o: $(OBJS) -uspp2upf.o: $(OBJS) -vanderbilt.o: $(OBJS) -vdb2upf.o: $(OBJS) - include .dependencies diff --git a/upftools/fpmd2upf.f90 b/upftools/fpmd2upf.f90 index 1343480e4..414bab6b7 100644 --- a/upftools/fpmd2upf.f90 +++ b/upftools/fpmd2upf.f90 @@ -5,62 +5,6 @@ ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! -! -! -module upf - ! - ! All variables to be written into the UPF file - ! (UPF = unified pseudopotential format) - ! - ! pp_info - integer :: rel - real(kind=8) :: rcloc - integer :: nwfs - real(kind=8), allocatable :: oc(:), rcut(:), rcutus(:), epseu(:) - character(len=2), allocatable :: els(:) - integer, allocatable:: lchi (:), nns (:) - ! - ! pp_header - character (len=80):: generated, date_author, comment - character (len=2) :: psd, pseudotype - integer :: nv = 0 - integer :: iexch, icorr, igcx, igcc - integer :: lmax, mesh, nbeta, ntwfc - logical :: nlcc - real(kind=8) :: zp, ecutrho, ecutwfc, etotps - real(kind=8), allocatable :: ocw(:) - character(len=2), allocatable :: elsw(:) - integer, allocatable:: lchiw(:) - ! - ! pp_mesh - real(kind=8), allocatable :: r(:), rab(:) - ! - ! pp_nlcc - real(kind=8), allocatable :: rho_atc(:) - ! - ! pp_local - real(kind=8), allocatable :: vloc0(:) - ! - ! pp_nonlocal - ! pp_beta - real(kind=8), allocatable :: betar(:,:) - integer, allocatable:: lll(:), ikk2(:) - ! pp_dij - real(kind=8), allocatable :: dion(:,:) - ! pp_qij - integer :: nqf, nqlc - real(kind=8), allocatable :: rinner(:), qqq(:,:), qfunc(:,:,:) - ! pp_qfcoef - real(kind=8), allocatable :: qfcoef(:,:,:,:) - ! - ! pp_pswfc - real(kind=8), allocatable :: chi(:,:) - ! - ! pp_rhoatom - real(kind=8), allocatable :: rho_at(:) -end module upf -! - module fpmd2upf_module USE kinds, ONLY: dbl @@ -952,390 +896,6 @@ program fpmd2upf end program - -subroutine write_upf(ounps) - - use upf, only: nlcc - - integer :: ounps - - call write_pseudo_comment(ounps) - call write_pseudo_header(ounps) - call write_pseudo_mesh(ounps) - if (nlcc) call write_pseudo_nlcc(ounps) - call write_pseudo_local(ounps) - call write_pseudo_nl(ounps) - call write_pseudo_pswfc(ounps) - call write_pseudo_rhoatom(ounps) - ! - print '("*** PLEASE TEST BEFORE USING!!! ***")' - print '("review the content of the PP_INFO fields")' - ! -end subroutine write_upf - - ! - !--------------------------------------------------------------------- - subroutine write_pseudo_comment (ounps) - !--------------------------------------------------------------------- - ! - ! - ! This routine writes the comments of the new UPF file - ! - use upf - implicit none - integer :: ounps - - integer :: nb, ios - - write (ounps, '(a9)', err = 100, iostat = ios) "" - - write (ounps, '(a)', err = 100, iostat = ios) generated - write (ounps, '(a)', err = 100, iostat = ios) date_author - write (ounps, '(a)', err = 100, iostat = ios) comment - if (rel==2) then - write (ounps, '(i5,t14,a)', err = 100, iostat = ios) rel,& - &"The Pseudo was generated with a Full-Relativistic Calculation" - else if (rel==1) then - write (ounps, '(i5,t14,a)', err = 100, iostat = ios) rel,& - &"The Pseudo was generated with a Scalar-Relativistic Calculation" - else - write (ounps, '(i5,t14,a)', err = 100, iostat = ios) rel, & - & "The Pseudo was generated with a Non-Relativistic Calculation" - endif - - write (ounps, '(1pe19.11,t24,a)', err = 100, iostat = ios) & - rcloc, "Local Potential cutoff radius" - - write (ounps, '(a2,2a3,a6,3a19)', err = 100, iostat = ios) "nl", & - &" pn", "l", "occ", "Rcut", "Rcut US", "E pseu" - do nb = 1, nwfs - write (ounps, '(a2,2i3,f6.2,3f19.11)') els (nb) , nns (nb) , & - lchi (nb) , oc (nb) , rcut (nb) , rcutus (nb) , epseu(nb) - - enddo - - write (ounps, '(a10)', err = 100, iostat = ios) "" - return -100 call errore ('write_pseudo_comment', 'Writing pseudo file', abs ( & - ios)) - end subroutine write_pseudo_comment - - ! - !--------------------------------------------------------------------- - subroutine write_pseudo_header (ounps) - !--------------------------------------------------------------------- - ! - ! - ! This routine writes the header of the new UPF file - ! - use upf - implicit none - integer :: ounps - ! - character (len=4) :: shortname - character (len=20):: dft - integer :: nb, ios - ! - ! - write (ounps, '(//a11)', err = 100, iostat = ios) "" - - write (ounps, '(t3,i2,t24,a)', err = 100, iostat = ios) nv, & - "Version Number" - write (ounps, '(t3,a,t24,a)', err = 100, iostat = ios) psd , & - "Element" - if (pseudotype == 'NC') then - write (ounps, '(a5,t24,a)', err = 100, iostat = ios) "NC", & - "Norm - Conserving pseudopotential" - else if (pseudotype == 'US') then - write (ounps, '(a5,t24,a)', err = 100, iostat = ios) "US", & - "Ultrasoft pseudopotential" - else - call errore ('write_pseudo_header',& - 'Unknown PP type: '//pseudotype, 1) - endif - write (ounps, '(l5,t24,a)', err = 100, iostat = ios) nlcc , & - "Nonlinear Core Correction" - call dftname (iexch, icorr, igcx, igcc, dft, shortname) - write (ounps, '(a,t24,a4,a)', err = 100, iostat = ios) & - dft, shortname," Exchange-Correlation functional" - write (ounps, '(f17.11,t24,a)') zp , "Z valence" - write (ounps, '(f17.11,t24,a)') etotps, "Total energy" - write (ounps, '(2f11.7,t24,a)') ecutrho, ecutwfc, & - "Suggested cutoff for wfc and rho" - - write (ounps, '(i5,t24,a)') lmax, "Max angular momentum component" - write (ounps, '(i5,t24,a)') mesh, "Number of points in mesh" - write (ounps, '(2i5,t24,a)', err = 100, iostat = ios) ntwfc, & - nbeta , "Number of Wavefunctions, Number of Projectors" - write (ounps, '(a,t24,a2,a3,a6)', err = 100, iostat = ios) & - " Wavefunctions", "nl", "l", "occ" - do nb = 1, ntwfc - write (ounps, '(t24,a2,i3,f6.2)') elsw(nb), lchiw(nb), ocw(nb) - enddo - !---> End header writing - - write (ounps, '(a12)', err = 100, iostat = ios) "" - return -100 call errore ('write_pseudo_header','Writing pseudo file', abs(ios) ) - - end subroutine write_pseudo_header - - ! - !--------------------------------------------------------------------- - subroutine write_pseudo_mesh (ounps) - !--------------------------------------------------------------------- - ! - ! - ! This routine writes the atomic charge density to the new UPF file - ! - use upf - implicit none - integer :: ounps - ! - integer :: ir, ios - ! - write (ounps, '(//a9)', err = 100, iostat = ios) "" - - write (ounps, '(t3,a6)', err = 100, iostat = ios) "" - write (ounps, '(1p4e19.11)', err=100, iostat=ios) (r(ir), ir=1,mesh ) - write (ounps, '(t3,a7)', err = 100, iostat = ios) "" - write (ounps, '(t3,a8)', err = 100, iostat = ios) "" - write (ounps, '(1p4e19.11)', err=100, iostat=ios) (rab(ir), ir=1,mesh ) - write (ounps, '(t3,a9)', err = 100, iostat = ios) "" - - write (ounps, '(a10)', err = 100, iostat = ios) "" - - return - -100 call errore ('write_pseudo_rhoatom','Writing pseudo file',abs(ios)) - - end subroutine write_pseudo_mesh - - ! - !--------------------------------------------------------------------- - subroutine write_pseudo_nlcc (ounps) - !--------------------------------------------------------------------- - ! - ! - ! This routine writes the core charge for the nonlinear core - ! correction of the new UPF file - ! - use upf - implicit none - integer :: ounps - ! - integer :: ir, ios - - write (ounps, '(//a9)', err = 100, iostat = ios) "" - - write (ounps, '(1p4e19.11)', err=100, iostat=ios) & - ( rho_atc(ir), ir = 1, mesh ) - write (ounps, '(a10)', err = 100, iostat = ios) "" - return - -100 call errore ('write_pseudo_nlcc', 'Writing pseudo file', abs (ios)) - - end subroutine write_pseudo_nlcc - ! - !--------------------------------------------------------------------- - subroutine write_pseudo_local (ounps) - !--------------------------------------------------------------------- - ! - ! - ! This routine writes the local part of the new UPF file - ! - use upf - implicit none - integer :: ounps - ! - integer :: ir, ios - - write (ounps, '(//a10)', err = 100, iostat = ios) "" - write (ounps, '(1p4e19.11)', err=100, iostat=ios) & - ( vloc0(ir), ir = 1, mesh ) - write (ounps, '(a11)', err = 100, iostat = ios) "" - return -100 call errore ('write_pseudo_local', 'Writing pseudo file', abs(ios) ) - end subroutine write_pseudo_local - - ! - !--------------------------------------------------------------------- - subroutine write_pseudo_nl (ounps) - !--------------------------------------------------------------------- - ! - ! - ! This routine writes the non local part of the new UPF file - ! - use upf - implicit none - integer :: ounps - ! - integer :: nb, mb, n, ir, nd, i, lp, ios - - write (ounps, '(//a13)', err = 100, iostat = ios) "" - do nb = 1, nbeta - write (ounps, '(t3,a9)', err = 100, iostat = ios) "" - write (ounps, '(2i5,t24,a)', err=100, iostat=ios) & - nb, lll(nb), "Beta L" - write (ounps, '(i6)', err=100, iostat=ios) ikk2 (nb) - write (ounps, '(1p4e19.11)', err=100, iostat=ios) & - ( betar(ir,nb), ir=1,ikk2(nb) ) - write (ounps, '(t3,a10)', err = 100, iostat = ios) "" - enddo - - write (ounps, '(t3,a8)', err = 100, iostat = ios) "" - nd = 0 - do nb = 1, nbeta - do mb = nb, nbeta - if ( abs(dion(nb,mb)) .gt. 1.0d-12 ) nd = nd + 1 - enddo - enddo - write (ounps, '(1p,i5,t24,a)', err=100, iostat=ios) & - nd, "Number of nonzero Dij" - do nb = 1, nbeta - do mb = nb, nbeta - if ( abs(dion(nb,mb)) .gt. 1.0d-12 ) & - write(ounps,'(1p,2i5,e19.11)', err=100, iostat=ios) & - nb, mb, dion(nb,mb) - enddo - enddo - write (ounps, '(t3,a9)', err=100, iostat=ios) "" - - if (pseudotype == 'US') then - write (ounps, '(t3,a8)', err = 100, iostat = ios) "" - write (ounps, '(i5,a)',err=100, iostat=ios) nqf," nqf.& - & If not zero, Qij's inside rinner are computed using qfcoef's" - if (nqf.gt.0) then - write (ounps, '(t5,a11)', err=100, iostat=ios) "" - write (ounps,'(i5,1pe19.11)', err=100, iostat=ios) & - (i, rinner(i), i = 1, nqlc) - write (ounps, '(t5,a12)', err=100, iostat=ios) "" - end if - do nb = 1, nbeta - do mb = nb, nbeta - write (ounps, '(3i5,t24,a)', err=100, iostat=ios) & - nb, mb, lll(mb) , "i j (l(j))" - write (ounps, '(1pe19.11,t24,a)', err=100, iostat=ios) & - qqq(nb,mb), "Q_int" - write (ounps, '(1p4e19.11)', err=100, iostat=ios) & - ( qfunc (n,nb,mb), n=1,mesh ) - if (nqf.gt.0) then - write (ounps, '(t5,a11)', err=100, iostat=ios) & - "" - write(ounps,'(1p4e19.11)', err=100, iostat=ios) & - ((qfcoef(i,lp,nb,mb),i=1,nqf),lp=1,nqlc) - write (ounps, '(t5,a12)', err=100, iostat=ios) & - "" - end if - enddo - enddo - write (ounps, '(t3,a9)', err = 100, iostat = ios) "" - - endif - write (ounps, '(a14)', err = 100, iostat = ios) "" - return - -100 call errore ('write_pseudo_nl', 'Writing pseudo file', abs (ios) ) - - end subroutine write_pseudo_nl - - ! - !--------------------------------------------------------------------- - subroutine write_pseudo_pswfc (ounps) - !--------------------------------------------------------------------- - ! - ! - ! This routine writes the pseudo atomic functions - ! of the new UPF file - ! - use upf - implicit none - integer :: ounps - ! - integer :: nb, ir, ios - - write (ounps, '(//a10)', err = 100, iostat = ios) "" - do nb = 1, ntwfc - write (ounps,'(a2,i5,f6.2,t24,a)', err=100, iostat=ios) & - elsw(nb), lchiw(nb), ocw(nb), "Wavefunction" - write (ounps, '(1p4e19.11)', err=100, iostat=ios) & - ( chi(ir,nb), ir=1,mesh ) - enddo - write (ounps, '(a11)', err = 100, iostat = ios) "" - return - -100 call errore ('write_pseudo_pswfc', 'Writing pseudo file', abs(ios) ) - end subroutine write_pseudo_pswfc - ! - !--------------------------------------------------------------------- - subroutine write_pseudo_rhoatom (ounps) - !--------------------------------------------------------------------- - ! - ! - ! This routine writes the atomic charge density to the new UPF file - ! - use upf - implicit none - integer :: ounps - ! - integer :: ir, ios - - write (ounps, '(//a12)', err = 100, iostat = ios) "" - write (ounps, '(1p4e19.11)', err = 100, iostat = ios) & - ( rho_at(ir), ir=1,mesh ) - write (ounps, '(a13)', err = 100, iostat = ios) "" - return - -100 call errore('write_pseudo_rhoatom','Writing pseudo file',abs(ios)) - end subroutine write_pseudo_rhoatom - - !--------------------------------------------------------------------- - subroutine dftname(iexch, icorr, igcx, igcc, longname, shortname) - !--------------------------------------------------------------------- - implicit none - integer iexch, icorr, igcx, igcc - character (len=4) :: shortname - character (len=20):: longname - ! - ! The data used to convert iexch, icorr, igcx, igcc - ! into a user-readable string - ! - integer, parameter :: nxc = 1, ncc = 9, ngcx = 3, ngcc = 4 - character (len=4) :: exc, corr, gradx, gradc - dimension exc (0:nxc), corr (0:ncc), gradx (0:ngcx), gradc (0:ngcc) - data exc / 'NOX ', 'SLA ' / - data corr / 'NOC ', 'PZ ', 'VWN ', 'LYP ', 'PW ', 'WIG ', 'HL ',& - 'OBZ ', 'OBW ', 'GL ' / - data gradx / 'NOGX', 'B88 ', 'GGX ', 'PBE ' / - data gradc / 'NOGC', 'P86 ', 'GGC ', 'BLYP', 'PBE ' / - - if (iexch==1.and.igcx==0.and.igcc==0) then - shortname = corr(icorr) - else if (iexch==1.and.icorr==3.and.igcx==1.and.igcc==3) then - shortname = 'BLYP' - else if (iexch==1.and.icorr==1.and.igcx==1.and.igcc==0) then - shortname = 'B88' - else if (iexch==1.and.icorr==1.and.igcx==1.and.igcc==1) then - shortname = 'BP' - else if (iexch==1.and.icorr==4.and.igcx==2.and.igcc==2) then - shortname = 'PW91' - else if (iexch==1.and.icorr==4.and.igcx==3.and.igcc==4) then - shortname = 'PBE' - else - shortname = ' ' - end if - write(longname,'(4a5)') exc(iexch),corr(icorr),gradx(igcx),gradc(igcc) - - return -end subroutine dftname - -subroutine errore(a,b,n) - character(len=*) :: a,b - - write(6,'(//'' program '',a,'':'',a,''.'',8x,i8,8x,''stop'')') a,b,n - stop -end subroutine errore - !---------------------------------------------------------------------- subroutine simpson2(mesh,func,rab,asum) !-----------------------------------------------------------------------