First attempt to write the input data for generation into the

pseudopotential file - sems to work 


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@9138 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2012-06-28 22:10:45 +00:00
parent 08e596df27
commit 359f01fc56
8 changed files with 78 additions and 39 deletions

View File

@ -15,7 +15,7 @@ MODULE open_close_input_file
LOGICAL, SAVE :: lxmlinput_loc = .false.
CHARACTER(LEN=256), SAVE :: input_file = ' '
PRIVATE
PUBLIC :: open_input_file, close_input_file
PUBLIC :: open_input_file, close_input_file, unit_loc
!
CONTAINS
!----------------------------------------------------------------------------

View File

@ -36,15 +36,17 @@ MODULE write_upf_v2_module
CONTAINS
!-------------------------------+
SUBROUTINE write_upf_v2(u, upf, conf) !
SUBROUTINE write_upf_v2(u, upf, conf, u_input)
!----------------------------+
! Write pseudopotential in UPF format version 2, uses iotk
!
IMPLICIT NONE
INTEGER,INTENT(IN) :: u ! i/o unit
TYPE(pseudo_upf),INTENT(IN) :: upf ! the pseudo data
INTEGER,INTENT(IN) :: u ! unit for writing
TYPE(pseudo_upf),INTENT(IN) :: upf ! the pseudo data
! optional: configuration used to generate the pseudopotential
TYPE(pseudo_config),OPTIONAL,INTENT(IN) :: conf
! optional: unit pointing to input file containing generation data
INTEGER, OPTIONAL, INTENT(IN) :: u_input
!
CHARACTER(len=iotk_attlenx) :: attr
!
@ -54,7 +56,8 @@ CONTAINS
!
! Write human-readable header
CALL write_info(u, upf, conf)
!
! Write input data used in generation (copy the input file)
IF ( PRESENT(u_input) ) CALL write_inpfile(u, u_input)
! Write machine-readable header
CALL write_header(u, upf)
! Write radial grid mesh
@ -203,6 +206,28 @@ CONTAINS
100 CALL errore('write_upf_v2::write_info', 'Writing pseudo file', 1)
END SUBROUTINE write_info
!
SUBROUTINE write_inpfile ( u, u_input )
IMPLICIT NONE
INTEGER,INTENT(IN) :: u, u_input ! units: read from u_input, write to u
INTEGER :: ierr ! /= 0 if something went wrong
LOGICAL :: opnd
CHARACTER(len=256) :: line
!
INQUIRE (unit=u_input, opened=opnd)
IF ( .NOT. opnd) RETURN
REWIND (unit=u_input)
WRITE (u,'("<PP_INPUTFILE>")')
10 READ (u_input, '(A)',end=20,err=30) line
WRITE (u, '(A)') TRIM(line)
GO TO 10
20 WRITE (u,'("</PP_INPUTFILE>")')
CLOSE (unit=u_input)
!
RETURN
30 CALL errore('write_upf_v2::write_inputfile', 'reading data file', 1)
END SUBROUTINE write_inpfile
!
SUBROUTINE write_header(u, upf)
IMPLICIT NONE
INTEGER,INTENT(IN) :: u ! i/o unit

View File

@ -6,7 +6,7 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
!---------------------------------------------------------------------
SUBROUTINE export_upf(iunps)
SUBROUTINE export_upf(iunps, unit_loc)
!---------------------------------------------------------------------
!
use constants, only : fpi
@ -30,12 +30,13 @@ SUBROUTINE export_upf(iunps)
use global_version, only: version_number, svn_revision
!
use pseudo_types
use upf_module, only : write_upf, pseudo_config, deallocate_pseudo_config
use upf_module, only : pseudo_config, deallocate_pseudo_config
use write_upf_v2_module, only: write_upf_v2
!
implicit none
!
!CHARACTER(len=*),INTENT(IN) :: filename
INTEGER,INTENT(IN)::iunps
INTEGER,INTENT(IN)::iunps, unit_loc
!
integer :: ibeta, jbeta, kbeta, l, ind, l1, l2
!
@ -267,7 +268,7 @@ SUBROUTINE export_upf(iunps)
upf%has_wfc = lsave_wfc
if (upf%has_wfc) CALL export_upf_wfc()
!
CALL write_upf(upf, at_conf, unit=iunps)
CALL write_upf_v2( iunps, upf, at_conf, unit_loc )
!
CALL deallocate_pseudo_upf( upf )
CALL deallocate_radial_grid( internal_grid )

View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2004-2007 Quantum ESPRESSO group
! Copyright (C) 2004-2012 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,
@ -18,6 +18,7 @@ subroutine ld1_readin
use constants, ONLY : rytoev, c_au
USE io_global, ONLY : ionode, ionode_id, stdout
USE mp, ONLY : mp_bcast
USE open_close_input_file, ONLY : open_input_file, close_input_file
use ld1inc, only : els, lls, betas, qq, qvan, ikk, nbeta, pseudotype, &
el, nn, ll, jj, oc, isw, nwf,rcut, rcutus, &
enls, nns, jjs, ocs, isws, nwfs, &
@ -175,8 +176,6 @@ subroutine ld1_readin
!
atom = ' '
zed = 0.0_dp
! xmin = -7.0_dp
! dx = 0.0125_dp
xmin = 0.0_dp
dx = 0.0_dp
rmax =100.0_dp
@ -217,14 +216,20 @@ subroutine ld1_readin
use_paw_as_gipaw = .false. !EMINE
relpert = .false.
! check if reading from file, dump stdin to file otherwise
! (when generating a pseudopotential, input data file is needed)
ios = 0
if (ionode) ios = open_input_file()
call mp_bcast(ios, ionode_id)
If ( ios > 0 ) call errore('ld1_readin','opening input file ',abs(ios))
! read the namelist input
if (ionode) then
CALL input_from_file()
read(5,input,err=100,iostat=ios)
end if
if (ionode) read(5,input,err=100,iostat=ios)
100 call mp_bcast(ios, ionode_id)
call errore('ld1_readin','reading input namelist ',abs(ios))
call bcast_input()
call mp_bcast( xmin, ionode_id )
call mp_bcast( dx, ionode_id )
@ -249,7 +254,7 @@ subroutine ld1_readin
if (nint(zdum) /= nint(zed)) call errore &
('ld1_readin','inconsistent Z/atom specification',nint(zdum))
end if
! with LDA-1/2 now iswitch <=4
! with LDA-1/2 now iswitch <=4
if (iswitch < 1 .or. iswitch > 4) &
call errore('ld1_readin','wrong iswitch',1)
if (eminld > emaxld) &
@ -335,10 +340,9 @@ subroutine ld1_readin
if (xmin > -2.0_dp) call errore('ld1_readin','wrong xmin',1)
if (dx <=0.0_dp) call errore('ld1_readin','wrong dx',1)
!
! generate the radial grid - note that if iswitch = 2 the radial grid
! is not generated but read from the pseudopotential file
! generate the radial grid - note that if iswitch = 2 or 4
! the radial grid is not generated but read from the pseudopotential file
!
! also for LDA-1/2 radial grid has to be read
if (iswitch /= 2.or.iswitch/=4) then
call do_mesh(rmax,zed,xmin,dx,0,grid)
rhoc=0.0_dp
@ -349,7 +353,9 @@ subroutine ld1_readin
!
! no more data needed for AE calculations
!
ios = close_input_file ( )
frozen_core=.false.
! PP generation: close input data file, keep if temporary
return
!
else if (iswitch == 3) then
@ -378,6 +384,7 @@ subroutine ld1_readin
if (ionode) read(5,inputp,err=500,iostat=ios)
500 call mp_bcast(ios, ionode_id)
call errore('ld1_readin','reading inputp',abs(ios))
call bcast_inputp()
if(which_augfun=='DEFAULT') then
@ -425,7 +432,6 @@ subroutine ld1_readin
do ns1=1,nwfs
if (lls(ns) == lls(ns1) .and. jjs(ns) == jjs(ns1)) c1=c1+1
enddo
!!!!
if (c1 < 2) then
write (stdout,'(/,5x,A)') &
'!!!!!!!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!!!!!!!!'
@ -434,7 +440,6 @@ subroutine ld1_readin
write (stdout,'(5x,A)') &
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
endif
!!!!
endif
enddo
if (nwfs > 1) then
@ -459,22 +464,21 @@ subroutine ld1_readin
ecutmax = 0.0_dp
decut = 5.0_dp
rm =30.0_dp
!
! default value for LDA-1/2
!
!
! default value for LDA-1/2
!
rcutv = -1.0
!
if (ionode) read(5,test,err=300,iostat=ios)
! read test namelist, if present
if (ionode) read(5,test,end=300,err=300,iostat=ios)
300 call mp_bcast(ios, ionode_id)
! LDA-1/2
if(iswitch==4) nconf = 2
if(iswitch==4.and.rcutv<0.0) call errore('ld1_readin','inconsistent rcutv',1)
!
! Added iswitch ==4 for LDA-1/2
if (iswitch==2.or.iswitch==4) call errore('ld1_readin','reading test',abs(ios))
! for LDA-1/2
if(iswitch==4) nconf = 2
!
call bcast_test()
call mp_bcast(configts, ionode_id)
!
@ -587,6 +591,10 @@ subroutine ld1_readin
! PP testing: reading the pseudopotential
!
if (iswitch ==2.or.iswitch==4) then
!
! close input data file, remove if temporary
!
ios = close_input_file ( )
lpaw=.false.
!
if (file_pseudo == ' ') &
@ -637,7 +645,6 @@ subroutine ld1_readin
ikk(ns)=grid%mesh
enddo
endif
!
endif
!
if (lpaw) then

View File

@ -25,6 +25,7 @@ subroutine ld1_writeout
iswitch
use funct, only : get_dft_name
use paw_type, only : deallocate_pseudo_paw
use open_close_input_file, only: close_input_file, unit_loc
implicit none
@ -88,9 +89,9 @@ subroutine ld1_writeout
else
!
if(upf_v1_format) then
call write_upf_atomic(iunps)
call write_upf_v1(iunps)
else
call export_upf(iunps)
call export_upf(iunps, unit_loc)
endif
!
if(lpaw) call deallocate_pseudo_paw( pawsetup )
@ -98,6 +99,8 @@ subroutine ld1_writeout
endif
!
close(iunps)
! close input data unit if not done previously
ios = close_input_file ( )
endif
!
return

View File

@ -147,6 +147,7 @@ export_upf.o : ../../Modules/pseudo_types.o
export_upf.o : ../../Modules/radial_grids.o
export_upf.o : ../../Modules/upf.o
export_upf.o : ../../Modules/version.o
export_upf.o : ../../Modules/write_upf_v2.o
export_upf.o : ../../iotk/src/iotk_module.o
export_upf.o : ld1inc.o
find_qi.o : ../../Modules/kind.o
@ -191,6 +192,7 @@ ld1_readin.o : ../../Modules/funct.o
ld1_readin.o : ../../Modules/io_global.o
ld1_readin.o : ../../Modules/kind.o
ld1_readin.o : ../../Modules/mp.o
ld1_readin.o : ../../Modules/open_close_input_file.o
ld1_readin.o : ../../Modules/parameters.o
ld1_readin.o : ../../Modules/radial_grids.o
ld1_readin.o : atomic_paw.o
@ -202,6 +204,7 @@ ld1_setup.o : ld1inc.o
ld1_writeout.o : ../../Modules/funct.o
ld1_writeout.o : ../../Modules/io_global.o
ld1_writeout.o : ../../Modules/mp.o
ld1_writeout.o : ../../Modules/open_close_input_file.o
ld1_writeout.o : ../../Modules/radial_grids.o
ld1_writeout.o : ld1inc.o
ld1_writeout.o : paw_type.o

View File

@ -5,7 +5,7 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
subroutine write_upf_atomic(ounps)
subroutine write_upf_v1(ounps)
use ld1inc, only: nlcc, rel, lpaw, lgipaw_reconstruction, &
use_paw_as_gipaw
@ -30,7 +30,7 @@ subroutine write_upf_atomic(ounps)
if ( lgipaw_reconstruction.and.(.not.use_paw_as_gipaw) ) call write_pseudo_gipaw(ounps)
!
!
end subroutine write_upf_atomic
end subroutine write_upf_v1
!
!---------------------------------------------------------------------
subroutine write_pseudo_comment (ounps)

View File

@ -47,7 +47,7 @@ SUBROUTINE input_from_file( )
!
! TODO: return error code ierr (-1 no file, 0 file opened, > 1 error)
! do not call "errore" here: it may hang in parallel execution
! if this routine ois called by ionode only
! if this routine is called by ionode only
!
IF ( ierr > 0 ) WRITE (stderr, &
'(" *** input file ",A," not found ***")' ) TRIM( input_file )