Updated pwi2xsf utility, fully up-to-date with PW2.0.

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@592 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
kokalj 2004-02-13 13:20:19 +00:00
parent 7263de43b8
commit e9ca78e806
4 changed files with 414 additions and 493 deletions

View File

@ -2,100 +2,426 @@
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Tone: File adapted from pwi2xsf.f file of XCRYSDEN distribution
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
c ------------------------------------------------------------------------
program pwi2xsf
c reads preprocessed (with pwi2xsf.sh) PWscf v1.0 input-file
c Reads pre-procesed (with pwi2xsf.sh) PW-input file
c and converts to XSF format file
c
c This program reads the NEWLY formated preprocessed-PW.X input
c
c Usage: pwi2xsf.sh < PW-preprocessed file
c ------------------------------------------------------------------------
implicit none
integer maxtyp
c maxtyp : maximum number of types of atoms
c maxatom: maximum number of atoms
integer
$ maxtyp,
$ maxatom,
$ ALAT_UNIT,
$ BOHR_UNIT,
$ ANGSTROM_UNIT,
$ CRYSTAL_UNIT
real*8
$ bohr
parameter (maxtyp = 100, bohr = 0.529177d0)
parameter (
$ maxtyp = 100,
$ maxatom = 10000,
$ bohr = 0.529177d0,
$
$ ALAT_UNIT = 1,
$ BOHR_UNIT = 2,
$ ANGSTROM_UNIT = 3,
$ CRYSTAL_UNIT = 4 )
integer
$ ibrav, ! label for Bravais lattice
$ nat, ! number of atoms
$ ntyp ! number of pseudopotentials
$ ntyp, ! number of pseudopotentials
$ num_of_images, ! number of NEB images
$ atomic_posunit ! length-unit of atomic positions
real*8
$ celldm(6), ! cell parameters
$ omega, ! cell volume (not used)
$ alat ! lattice parameter
$ alat, ! lattice parameter
$ a, b, c, cosab, cosac, cosbc ! lattice parameters
character
$ dummy*80
$ calculation*80, ! type of calculation
$ line*120 ! line of input
character*3
$ atm(maxatom) ! atomic symbols
integer
$ ityp, ! type of PP
$ atn(maxtyp), ! nuclear charge
$ ounit, ! output unit
$ i, j ! dummies
$ i, j, ! dummies
$ inat, iim, m, ! counters
$ i_trimleft_white_space, ! string whitespace-triming function
$ len ! length of string
real*8
$ tau( 3 ),
+ p( 3,3 ), ! lattice vectors (PRIMITIVE)
+ c( 3,3 ) ! lattice vectors (CONVENTIONAL)
$ x,y,z,w1,w2, ! Cartesian coordinates & weights
$ tau(3,maxatom), ! atomic coordinates
$ tau2(3,maxatom), ! atomic coordinates (2nd image)
+ pv( 3,3 ), ! lattice vectors (PRIMITIVE)
+ cv( 3,3 ) ! lattice vectors (CONVENTIONAL)
logical
$ ltaucry
namelist/input/ ibrav, nat, celldm, ltaucry
ltaucry = .false.
namelist/system/
$ ibrav, nat, celldm, a, b, c, cosab, cosac, cosbc,
$ calculation, num_of_images
ounit=6
c set default values
calculation = 'scf'
num_of_images = 1
nat = 0
ibrav = 0
celldm(1) = 0.0d0
do i=1,maxtyp
atn(i) = 0
enddo
open(1, file='nuclei.charges', status='old')
read (1,*) ntyp
do i=1,ntyp
read (1,*) j,atn(j)
enddo
close(1)
read (5,input)
a = 0.0D0
b = 0.0D0
c = 0.0D0
cosab = 0.0D0
cosac = 0.0D0
cosbc = 0.0D0
c
c read namelist system
c
read (5,system)
if ( nat.eq.0 .or. celldm(1).eq.0.0d0 ) then
print *,'ERROR reading INPUT. STOPPING !!!'
print *,'ERROR: while reading INPUT !!!'
STOP
endif
if ( ibrav.eq.0 ) then
c read custom lattice
read (5,*) ((p(i,j),i=1,3),j=1,3)
read (5,*) dummy
else
call latgen( ibrav, celldm, p(1,1), p(1,2), p(1,3), omega)
c was lattice specified in terms of A,B,C,...
if ( celldm(1) .eq. 0.0D0 .AND. a .ne. 0.0D0 ) THEN
if ( ibrav .eq. 0 ) ibrav = 14
celldm(1) = a / bohr
celldm(2) = b / a
celldm(3) = c / a
celldm(4) = cosab
celldm(5) = cosac
celldm(6) = cosbc
else if ( celldm(1) .ne. 0.0D0 .AND. a .ne. 0.0D0 ) THEN
print *, 'ERROR: do not specify both celldm and a,b,c !!!'
endif
c
c read the rest of the input
c
990 continue
read(5,'(a120)',end=999) line
len = i_trimleft_white_space(line)
c
c CELL_PARAMETERS
c
if ( line(1:15) .eq. 'CELL_PARAMETERS' ) then
read (5,*) ((pv(i,j),i=1,3),j=1,3)
do j=1,3
do i=1,3
p(i,j) = p(i,j)/celldm(1)
cv(i,j) = pv(i,j)
end do
end do
c
c ATOMIC_POSITIONS
c
elseif ( line(1:16) .eq. 'ATOMIC_POSITIONS' ) then
c find out the length-unit
line = line(17:len)
len = i_trimleft_white_space(line)
atomic_posunit = ALAT_UNIT
if (len.gt.0 ) then
if ( line(1:4) .eq. 'ALAT' ) then
atomic_posunit = ALAT_UNIT
elseif ( line(1:4) .eq. 'BOHR' ) then
atomic_posunit = BOHR_UNIT
elseif ( line(1:7) .eq. 'CRYSTAL' ) then
atomic_posunit = CRYSTAL_UNIT
elseif ( line(1:8) .eq.'ANGSTROM') then
atomic_posunit = ANGSTROM_UNIT
endif
endif
c
c read atoms
c
if ( calculation(1:3) .ne. 'NEB' ) then
call read_atoms(nat,atm,tau)
else
c
c NEB: read atoms
c
if (num_of_images.lt.2) num_of_images=2
read (5,'(a120)') line ! line: first_image
call read_atoms(nat,atm,tau)
read (5,'(a120)') line ! line: second_image
call read_atoms(nat,atm,tau2)
endif
endif
goto 990
999 continue
if ( ibrav.ne.0 ) then
call latgen( ibrav, celldm,
$ pv(1,1), pv(1,2), pv(1,3),
$ cv(1,1), cv(1,2), cv(1,3), omega )
do j=1,3
do i=1,3
pv(i,j) = pv(i,j)/celldm(1)
end do
end do
call latgen_conventional(ibrav, celldm,
$ pv(1,1), pv(1,2), pv(1,3),
$ cv(1,1), cv(1,2), cv(1,3))
endif
call latgen_conventional (ibrav, celldm, p(1,1), p(1,2), p(1,3),
$ c(1,1), c(1,2), c(1,3))
alat = bohr*celldm(1)
call write_XSF_header (alat, p, c, nat, ounit)
call write_XSF_header (num_of_images,alat, pv, cv, nat, ounit)
do i=1,nat
read(5,*) tau(1), tau(2), tau(3), ityp
if (ltaucry) call cryst_to_cart(1, tau, p, 1)
write(ounit,'(i3,2x,3f15.10)') atn(ityp),
$ alat*tau(1), alat*tau(2), alat*tau(3)
do inat=1,nat
if ( atomic_posunit .eq. BOHR_UNIT ) then
tau(1,inat) = bohr * tau(1,inat)
tau(2,inat) = bohr * tau(2,inat)
tau(3,inat) = bohr * tau(3,inat)
tau2(1,inat) = bohr * tau2(1,inat)
tau2(2,inat) = bohr * tau2(2,inat)
tau2(3,inat) = bohr * tau2(3,inat)
elseif ( atomic_posunit .eq. ALAT_UNIT ) then
tau(1,inat) = alat * tau(1,inat)
tau(2,inat) = alat * tau(2,inat)
tau(3,inat) = alat * tau(3,inat)
tau2(1,inat) = alat * tau2(1,inat)
tau2(2,inat) = alat * tau2(2,inat)
tau2(3,inat) = alat * tau2(3,inat)
elseif ( atomic_posunit .eq. CRYSTAL_UNIT ) then
call cryst_to_cart(1, tau(1,inat), pv, 1)
call cryst_to_cart(1, tau2(1,inat),pv, 1)
tau(1,inat) = alat * tau(1,inat)
tau(2,inat) = alat * tau(2,inat)
tau(3,inat) = alat * tau(3,inat)
tau2(1,inat) = alat * tau2(1,inat)
tau2(2,inat) = alat * tau2(2,inat)
tau2(3,inat) = alat * tau2(3,inat)
endif
if ( num_of_images .lt. 2 ) then
write(ounit,'(a3,2x,3f15.10)')
$ atm(inat), tau(1,inat), tau(2,inat), tau(3,inat)
endif
enddo
if ( num_of_images .ge. 2 ) then
m = num_of_images - 1
do iim=1,num_of_images
w1 = dble(m-(iim-1))/dble(m)
w2 = dble(iim-1)/dble(m)
write(ounit,'('' PRIMCOORD '',i5)') iim
write(ounit,*) nat, 1
do inat=1,nat
x = w1*tau(1,inat) + w2*tau2(1,inat)
y = w1*tau(2,inat) + w2*tau2(2,inat)
z = w1*tau(3,inat) + w2*tau2(3,inat)
write(ounit,'(a3,2x,3f15.10)') atm(inat), x, y, z
enddo
enddo
endif
END
c---------------------------------------------------------------------
subroutine latgen_conventional
+ ( ibrav, celldm, p1, p2, p3, c1, c2, c3 )
c Generate convetional lattice
c---------------------------------------------------------------------
c
c Conventional crystallographic vectors c1, c2, and c3.
c See "latgen" for the meaning of variables
c
implicit none
c
c First the input variables
c
real*8
+ celldm( 6 ), ! input : the dimensions of the lattice
+ p1( 3 ), ! input : first lattice vector (PRIMITIVE)
+ p2( 3 ), ! input : second lattice vector
+ p3( 3 ), ! input : third lattice vector
+ c1( 3 ), ! output: first lattice vector(CONVENTIONAL)
+ c2( 3 ), ! output: second lattice vector
+ c3( 3 ) ! output: third lattice vector
integer
+ ibrav ! input: the index of the Bravais lattice
c
integer i
c
c
do i = 1, 3
c1(i) =0.d0
c2(i) =0.d0
c3(i) =0.d0
end do
c
if ( ibrav .eq. 2 .or. ibrav .eq.3 ) then
c
c fcc and bcc lattice
c
c1( 1 ) = 1.0d0
c2( 2 ) = 1.0d0
c3( 3 ) = 1.0d0
c
else if ( ibrav .eq. 7 ) then
c
c body centered tetragonal lattice
c
if ( celldm( 1 ) .le. 0.d0 .or. celldm( 3 ) .le. 0.d0 )
+ call errore( 'latgen', 'wrong celldm', 7 )
c1(1) = 1.0d0
c2(2) = 1.0d0
c3(3) = celldm(3)
c
else if ( ibrav .eq. 10 ) then
c
c All face centered orthorombic lattice
c
if ( celldm( 1 ) .le. 0.d0 .or. celldm( 2 ) .le. 0.d0
+ .or. celldm( 3 ) .le. 0.d0 )
+ call errore( 'latgen', 'wrong celldm', 10 )
c1(1) = 1.0d0
c2(2) = celldm(2)
c3(3) = celldm(3)
c
elseif ( ibrav .eq. 11 ) then
c
c Body centered orthorombic lattice
c
if ( celldm( 1 ) .le. 0.d0 .or. celldm( 2 ) .le. 0.d0
+ .or. celldm( 3 ) .le. 0.d0 )
+ call errore( 'latgen', 'wrong celldm', 11 )
c1(1) = 1.0d0
c2(2) = celldm(2)
c3(3) = celldm(3)
else
c **********
c all other cases : just copy p vectors to c vectors !!!
c **********
do i = 1, 3
c1( i ) = p1( i )
c2( i ) = p2( i )
c3( i ) = p3( i )
enddo
end if
c
return
end
c ------------------------------------------------------------------------
subroutine read_atoms(nat,atm,coor)
c read atomic coordinates
c ------------------------------------------------------------------------
implicit none
integer
$ nat, ! number of atoms
$ ipol,inat,len, ! counters
$ i_trimleft_white_space ! integer-function
character
$ line*120 ! line of input
character*3
$ atm(*) ! atomic symbols
real*8
$ coor(3,*)
do inat=1,nat
10 continue
read (5,'(a120)') line
len = i_trimleft_white_space(line)
if (len.eq.0) then
c an empty line, read again
goto 10
endif
atm(inat) = line(1:3)
line = line(3:len)
read (line,*) (coor(ipol,inat),ipol=1,3)
enddo
return
end
c ------------------------------------------------------------------------
subroutine write_XSF_header (num_of_images,alat, p, c, nat, ounit)
c writes the header for XSF structure file
c ------------------------------------------------------------------------
real*8
$ alat, ! lattice parameter
$ p(3,3), c(3,3), ! lattive vectors (PRIMITIVE & CONVETIONAL)
$ p1(3,3), c1(3,3) ! lattive vectors in ANGSTROMS unit
integer
$ nat, ! number of atoms
$ num_of_images, ! number of NEB images
$ ounit ! output unit
integer
$ i, j ! dummies
do i=1,3
do j=1,3
p1(i,j) = alat*p(i,j)
c1(i,j) = alat*c(i,j)
enddo
enddo
if (num_of_images .gt. 1)
$ write(ounit,'('' ANIMSTEPS '',i5)') num_of_images
write(ounit,'('' CRYSTAL'')')
write(ounit,'(/,'' PRIMVEC'')')
write(ounit,'(3(f15.10,2x,f15.10,2x,f15.10,/))')
$ ((p1(i,j),i=1,3),j=1,3)
write(ounit,'('' CONVVEC'')')
write(ounit,'(3(f15.10,2x,f15.10,2x,f15.10,/))')
$ ((c1(i,j),i=1,3),j=1,3)
if (num_of_images .eq. 1) then
write(ounit,'('' PRIMCOORD'')')
write(ounit,*) nat, 1
endif
return
end
c -------------------------------------------------
integer function i_trimleft_white_space(word)
c trim left white spaces out of word
c -------------------------------------------------
character word*(*), auxword*80
ilen=len(word)
auxword=word
do i=1,ilen
if ( word(i:i) .eq. ' ' ) then
auxword=word(i+1:ilen)
else
goto 1
endif
enddo
1 continue
i_trimleft_white_space=len(word)
word=auxword(1:i_trimleft_white_space)
return
END

View File

@ -3,14 +3,8 @@
# Author: #
# ------ #
# Anton Kokalj Email: Tone.Kokalj@ijs.si #
# Department of Physical and Organic Chemistry Phone: x 386 1 477 3523 #
# Jozef Stefan Institute Fax: x 386 1 477 3811 #
# Jamova 39, SI-1000 Ljubljana #
# SLOVENIA #
# #
# Source: $XCRYSDEN_TOPDIR/scripts/pwi2xsf.sh
# ------ #
# Copyright (c) 1996-2003 by Anton Kokalj #
# Copyright (c) 2004 by Anton Kokalj #
#############################################################################
#------------------------------------------------------------------------
@ -20,97 +14,24 @@
# or http://www.gnu.org/copyleft/gpl.txt .
#------------------------------------------------------------------------
#------------------------------------------------------------------------
# pwi2xsf.sh: PW-input to XSF conversion
#
# pwi2xsf.sh: PW-input to XSF converison
#
# Usage: pwi2xsf [-r] pw-input-file
#
#------------------------------------------------------------------------
pwError() {
echo "
========================================================================
$1
========================================================================
" 1>&2
if [ "$2" -ge 0 ]; then
exit $2
fi
}
# --------------------------------------------------------------------------
# FUNCTION: pwNucleiCharges --
#
# Purpose: ityp->nat conversion data
#
# Usage: pwNucleiCharges pw_input|pw_output outfile
#
# Side efect: creates nuclei.charges file
# --------------------------------------------------------------------------
pwNucleiCharges() {
#
# if file nuclei.charges does not exists prompt for ityp->nat conversion !!
#
if [ \( "$1" = "" \) -o \( "$2" = "" \) ]; then
pwError "Usage: pwNucleiCharges pw_input|pw_output outfile" 1
fi
# do we have PW-INPUT or PW-OUTPUT file ???
if [ "`cat $1 | egrep -i '&input|&system'`" != "" ]; then
# it is PW-INPUT
ntyp=`cat "$1" | awk '{gsub(",","\n"); print}' | grep ntyp \
| awk '{split($0,a,"=|,"); print a[2];}'`
else
# PW-OUTPUT
ntyp=`cat "$1" | grep 'number of atomic types' | \
head -1 | awk '{print $NF}'`
#echo 'NTYP=$ntyp'
if [ "$ntyp" = "" ]; then
# some older PWSCF versions didn't have "number of atomic
# types" printout -> user will have to make nuclei.charges
# file by himself/herself !!!
pwError "This is either non PW-output file or is a PW-output file
produced with some old PWSCF version" -1
echo -n "How many ityp->nat replacements ? " 1>&2
read ntyp
fi
fi
if [ ! -f nuclei.charges ]; then
echo -n "Please enter $ntyp ityp->nat replacements !!! " 1>&2
echo $ntyp > nuclei.charges
i=0
while [ $i -lt "$ntyp" ]
do
i=`echo "$i + 1"|bc`
echo "" 1>&2
echo "Replacement #${i}: ityp->nat" 1>&2
echo -n "ityp[$i]=$i; nat[$i]=" 1>&2; read nat
echo "$i $nat" >> nuclei.charges
done
fi
cat nuclei.charges > "$2"
}
# ------------------------------------------------------------------------
# MAIN
# ------------------------------------------------------------------------
# Last major rewrite by Tone Kokalj on Mon Feb 9 12:48:10 CET 2004
# ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
if [ "$#" -lt 1 ]; then
echo "
Usage: pwi2xsf.sh [-r] pw-input
-r ... one must specify i.e. ityp->nat conversion, and the corresponding
data are written to file nuclei.charges. The -r flag deletes this
Option for PWscf version < 1.2:
-r ... one must spefify i.e. ityp->nat conversion, and the corresponding
data are writen to file nuclei.charges. The -r flag deletes this
file.
" 1>&2
"
exit 1
fi
@ -131,23 +52,37 @@ if [ "$new_format1" != "" -a "$new_format2" != "" ]; then
#
cat $1 | awk 'BEGIN {RS=",";} {print $0}' | awk '
BEGIN {
end=0;
calculation="";
num_of_images="";
nml_end=0;
nml_end_string="";
}
toupper($0) ~ /&SYSTEM/ { sysnml=1; print; }
toupper($0) ~ /IBRAV|CELLDM|NAT/ { print; }
toupper($0) ~ /&SYSTEM/ { print; }
/ATOMIC_SPECIES|ATOMIC_POSITIONS|K_POINTS|CELL_PARAMETERS/ {
toupper($1) ~ /^IBRAV($|=)|^CELLDM\([1-6]\)($|=)|^NAT($|=)|^A($|=)|^B($|=)|^C($|=)|^COSAB($|=)|^COSAC($|=)|^COSBC($|=)/ { print; }
toupper($1) ~ /^CALCULATION($|=)/ { calculation=toupper($0); }
toupper($1) ~ /^NUM_OF_IMAGES($|=)/ { num_of_images=toupper($0); }
/ATOMIC_POSITIONS|CELL_PARAMETERS/ {
if ( !nml_end) {
# first finish the namelist
nml_end=1;
if (calculation != "") print calculation;
if (num_of_images != "") print num_of_images;
print nml_end_string;
}
# now print the current record
print_line=1;
print toupper($0);
next;
}
toupper($0) ~ /&END|^\/|^ \// {
if ( sysnml == 1 ) {
print;
sysnml=0;
}
nml_end_string=$0;
}
/a*/ {
@ -155,36 +90,23 @@ toupper($0) ~ /&END|^\/|^ \// {
print toupper($0);
}
}'> pw.$$
PWI2XSF=pwi2xsf_new
else
# we have OLD PW.X input format
pwNucleiCharges $1 /dev/null
cat $1 | awk 'BEGIN {RS=",";} {print}' | awk '
BEGIN {
end=0;
}
toupper($0) ~ /&INPUT|CELLDM|NAT|LTAUCRY/ { print; }
toupper($0) ~ /IBRAV/ {
print;
split($0,a,"=");
split(a[1],b,",");
ibrav = b[1];
}
toupper($0) ~ /&END|^\/|^ \// { end=1; }
/a*/ {
if ( end == 1 ) print;
}' > pw.$$
PWI2XSF=pwi2xsf
echo "
------------------------------------------------------------------------
ERROR: This is NOT a PW-input or an input for an older PW version
------------------------------------------------------------------------
"
exit 1
fi
#
# execute $PWI2XSF fortran program and print the XSF file
#
if [ \( "$XCRYSDEN_TOPDIR" != "" \) -a \( -x $XCRYSDEN_TOPDIR/bin/$PWI2XSF \) ]; then
$XCRYSDEN_TOPDIR/bin/$PWI2XSF < pw.$$ | tee pwi2xsf.xsf_out
if test -f $XCRYSDEN_TOPDIR/bin/$PWI2XSF ; then
$XCRYSDEN_TOPDIR/bin/pwi2xsf < pw.$$ | tee pwi2xsf.xsf_out
else
$PWI2XSF < pw.$$ | tee pwi2xsf.xsf_out
pwi2xsf.x < pw.$$ | tee pwi2xsf.xsf_out
fi
rm -f pw.$$

View File

@ -1,188 +0,0 @@
! 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 .
c ------------------------------------------------------------------------
program pwi2xsf_new
c reads preprocessed (with pwi2xsf.sh) PWscf v1.2 input-file
c and converts to XSF format file
c
c This program reads the NEWLY formated preprocessed-PW.X input
c
c Usage: pwi2xsf.sh < PW-preprocessed file
c ------------------------------------------------------------------------
implicit none
c maxtyp : maximum number of types of atoms
c maxatom: maximum number of atoms
integer
$ maxtyp,
$ maxatom,
$ ALAT_UNIT,
$ BOHR_UNIT,
$ ANGSTROM_UNIT,
$ CRYSTAL_UNIT
real*8
$ bohr
parameter (
$ maxtyp = 100,
$ maxatom = 10000,
$ bohr = 0.529177d0,
$
$ ALAT_UNIT = 1,
$ BOHR_UNIT = 2,
$ ANGSTROM_UNIT = 3,
$ CRYSTAL_UNIT = 4 )
integer
$ ibrav, ! label for Bravais lattice
$ nat, ! number of atoms
$ ntyp, ! number of pseudopotentials
$ atomic_posunit ! length-unit of atomic positions
real*8
$ celldm(6), ! cell parameters
$ omega, ! cell volume (not used)
$ alat ! lattice parameter
character
$ line*120 ! line of input
character*3
$ atm(maxatom) ! atomic symbols
integer
$ ityp, ! type of PP
$ ounit, ! output unit
$ i, j, ! dummies
$ ipol,inat, ! counters
$ i_trimleft_white_space, ! string whitespace-triming function
$ len ! length of string
real*8
$ tau(3,maxatom),
+ p( 3,3 ), ! lattice vectors (PRIMITIVE)
+ c( 3,3 ) ! lattice vectors (CONVENTIONAL)
logical
$ ltaucry
namelist/system/ ibrav, nat, celldm
ounit=6
c set default values
nat = 0
ibrav = 0
celldm(1) = 0.0d0
c read namelist system
read (5,system)
if ( nat.eq.0 .or. celldm(1).eq.0.0d0 ) then
print *,'ERROR reading INPUT. STOPING !!!'
STOP
endif
c print *,'DEBUG: namelist read'
c print *,'DEBUG: nat = ', nat
c read the rest of the input
990 continue
read(5,'(a120)',end=999) line
c print *,'DEBUG: read line :', line(1:40)
len = i_trimleft_white_space(line)
c print *,'DEBUG: read line_trim:', line(1:40)
c
c CELL_PARAMETERS
c
if ( line(1:15) .eq. 'CELL_PARAMETERS' ) then
read (5,*) ((p(i,j),i=1,3),j=1,3)
do j=1,3
do i=1,3
c(i,j) = p(i,j)
end do
end do
c
c ATOMIC_POSITIONS
c
elseif ( line(1:16) .eq. 'ATOMIC_POSITIONS' ) then
c find out the length-unit
line = line(17:len)
len = i_trimleft_white_space(line)
atomic_posunit = ALAT_UNIT
if (len.gt.0 ) then
if ( line(1:4) .eq. 'ALAT' ) then
atomic_posunit = ALAT_UNIT
elseif ( line(1:4) .eq. 'BOHR' ) then
atomic_posunit = BOHR_UNIT
elseif ( line(1:7) .eq. 'CRYSTAL' ) then
atomic_posunit = CRYSTAL_UNIT
elseif ( line(1:8) .eq.'ANGSTROM') then
atomic_posunit = ANGSTROM_UNIT
endif
endif
c read atoms
do inat=1,nat
10 continue
read (5,'(a120)') line
c print *,'DEBUG: line_len: line:',line(1:40)
len = i_trimleft_white_space(line)
c print *,'DEBUG: line_len: len: ',len, line
if (len.eq.0) then
c an empty line, read again
goto 10
endif
atm(inat) = line(1:3)
c print *,'DEBUG: atm():',atm(inat)
line = line(3:len)
read (line,*) (tau(ipol,inat),ipol=1,3)
enddo
endif
goto 990
999 continue
if ( ibrav.ne.0 ) then
call latgen( ibrav, celldm,
$ p(1,1), p(1,2), p(1,3), c(1,1), c(1,2), c(1,3), omega )
do j=1,3
do i=1,3
p(i,j) = p(i,j)/celldm(1)
end do
end do
call latgen_conventional(ibrav, celldm, p(1,1), p(1,2), p(1,3),
$ c(1,1), c(1,2), c(1,3))
endif
alat = bohr*celldm(1)
call write_XSF_header (alat, p, c, nat, ounit)
do inat=1,nat
if ( atomic_posunit .eq. BOHR_UNIT ) then
tau(1,inat) = bohr * tau(1,inat)
tau(2,inat) = bohr * tau(2,inat)
tau(3,inat) = bohr * tau(3,inat)
elseif ( atomic_posunit .eq. ALAT_UNIT ) then
tau(1,inat) = alat * tau(1,inat)
tau(2,inat) = alat * tau(2,inat)
tau(3,inat) = alat * tau(3,inat)
elseif ( atomic_posunit .eq. CRYSTAL_UNIT ) then
call cryst_to_cart(1, tau(1,inat), p, 1)
tau(1,inat) = alat * tau(1,inat)
tau(2,inat) = alat * tau(2,inat)
tau(3,inat) = alat * tau(3,inat)
endif
write(ounit,'(a3,2x,3f15.10)')
$ atm(inat), tau(1,inat), tau(2,inat), tau(3,inat)
enddo
END

View File

@ -1,139 +0,0 @@
c
c---------------------------------------------------------------------
subroutine latgen_conventional
+ ( ibrav, celldm, p1, p2, p3, c1, c2, c3 )
c---------------------------------------------------------------------
c
c Conventional crystallographic vectors c1, c2, and c3.
c See "latgen" for the meaning of variables
c
implicit none
c
c First the input variables
c
real*8
+ celldm( 6 ), ! input : the dimensions of the lattice
+ p1( 3 ), ! input : first lattice vector (PRIMITIVE)
+ p2( 3 ), ! input : second lattice vector
+ p3( 3 ), ! input : third lattice vector
+ c1( 3 ), ! output: first lattice vector(CONVENTIONAL)
+ c2( 3 ), ! output: second lattice vector
+ c3( 3 ) ! output: third lattice vector
integer
+ ibrav ! input: the index of the Bravais lattice
c
integer i
c
c
do i = 1, 3
c1(i) =0.d0
c2(i) =0.d0
c3(i) =0.d0
end do
c
if ( ibrav .eq. 2 .or. ibrav .eq.3 ) then
c
c fcc and bcc lattice
c
c1( 1 ) = 1.0d0
c2( 2 ) = 1.0d0
c3( 3 ) = 1.0d0
c
else if ( ibrav .eq. 7 ) then
c
c body centered tetragonal lattice
c
if ( celldm( 1 ) .le. 0.d0 .or. celldm( 3 ) .le. 0.d0 )
+ call errore( 'latgen', 'wrong celldm', 7 )
c1(1) = 1.0d0
c2(2) = 1.0d0
c3(3) = celldm(3)
c
else if ( ibrav .eq. 10 ) then
c
c All face centered orthorombic lattice
c
if ( celldm( 1 ) .le. 0.d0 .or. celldm( 2 ) .le. 0.d0
+ .or. celldm( 3 ) .le. 0.d0 )
+ call errore( 'latgen', 'wrong celldm', 10 )
c1(1) = 1.0d0
c2(2) = celldm(2)
c3(3) = celldm(3)
c
elseif ( ibrav .eq. 11 ) then
c
c Body centered orthorombic lattice
c
if ( celldm( 1 ) .le. 0.d0 .or. celldm( 2 ) .le. 0.d0
+ .or. celldm( 3 ) .le. 0.d0 )
+ call errore( 'latgen', 'wrong celldm', 11 )
c1(1) = 1.0d0
c2(2) = celldm(2)
c3(3) = celldm(3)
else
c **********
c all other cases : just copy p vectors to c vectors !!!
c **********
do i = 1, 3
c1( i ) = p1( i )
c2( i ) = p2( i )
c3( i ) = p3( i )
enddo
end if
c
return
end
c ------------------------------------------------------------------------
subroutine write_XSF_header (alat, p, c, nat, ounit)
c writes the header for XSF structure file
c ------------------------------------------------------------------------
real*8
$ alat, ! lattice parameter
$ p(3,3), c(3,3), ! lattive vectors (PRIMITIVE & CONVENTIONAL)
$ p1(3,3), c1(3,3) ! lattive vectors in ANGSTROMS unit
integer
$ nat, ! number of atoms
$ ounit ! output unit
integer
$ i, j ! dummies
do i=1,3
do j=1,3
p1(i,j) = alat*p(i,j)
c1(i,j) = alat*c(i,j)
enddo
enddo
write(ounit,'('' CRYSTAL'')')
write(ounit,'(/,'' PRIMVEC'')')
write(ounit,'(3(f15.10,2x,f15.10,2x,f15.10,/))')
$ ((p1(i,j),i=1,3),j=1,3)
write(ounit,'('' CONVVEC'')')
write(ounit,'(3(f15.10,2x,f15.10,2x,f15.10,/))')
$ ((c1(i,j),i=1,3),j=1,3)
write(ounit,'('' PRIMCOORD'')')
write(ounit,*) nat, 1
return
end
c
c -------------------------------------------------
integer function i_trimleft_white_space(word)
c trim left white spaces out of word
c -------------------------------------------------
character word*(*), auxword*80
ilen=len(word)
auxword=word
do i=1,ilen
if ( word(i:i) .eq. ' ' ) then
auxword=word(i+1:ilen)
else
goto 1
endif
enddo
1 continue
i_trimleft_white_space=len(word)
word=auxword(1:i_trimleft_white_space)
return
END