scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

More cleanup from Axel: 

- replace variables that have the names of keywords:
  IF (this should make the code non-compilable!),
  INT, SCALE.
- CALL getenv -> CALL get_env  (which is the only place to call
  getenv(). BTW, newer fortran standards now recommend to use
  CALL get_environment_variable, so it might be needed to have
  only one platform dependend place)
- makefile cleanup in VIB (more consistent with subdirs, not yet
  perfect).
- whitespace fix (avoid tabs!).


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@3591 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2006-12-11 10:19:53 +00:00
parent 8234ba2542
commit 9e294c022d
14 changed files with 118 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
CPV/geninv.f90
View File

@ -291,7 +291,7 @@
INTEGER I,ITER,J,JOBU,K,KASE,KK,L,LL,LLS,LM1,LP1,LS,LU,M,MAXIT, &
& MM,MM1,MP1,NCT,NCTP1,NCU,NRT,NRTP1
REAL(DP) DDOT,T,R
REAL(DP) B,C,CS,EL,EMM1,F,G,DNRM2,SCALE,SHIFT,SL,SM,SN, &
REAL(DP) B,C,CS,EL,EMM1,F,G,DNRM2,SCALEF,SHIFT,SL,SM,SN, &
& SMM1,T1,TEST,ZTEST
LOGICAL WANTU,WANTV
!
@ -591,13 +591,13 @@
!
! CALCULATE THE SHIFT.
!
SCALE = DMAX1(DABS(S(M)),DABS(S(M-1)),DABS(E(M-1)), &
SCALEF = DMAX1(DABS(S(M)),DABS(S(M-1)),DABS(E(M-1)), &
& DABS(S(L)),DABS(E(L)))
SM = S(M)/SCALE
SMM1 = S(M-1)/SCALE
EMM1 = E(M-1)/SCALE
SL = S(L)/SCALE
EL = E(L)/SCALE
SM = S(M)/SCALEF
SMM1 = S(M-1)/SCALEF
EMM1 = E(M-1)/SCALEF
SL = S(L)/SCALEF
EL = E(L)/SCALEF
B = ((SMM1 + SM)*(SMM1 - SM) + EMM1**2)/2.0D0
C = (SM*EMM1)**2
SHIFT = 0.0D0

32
CPV/optical.f90
View File

@ -61,7 +61,7 @@ CONTAINS
COMPLEX(DP) :: vkb(:,:)
INTEGER :: iss, ngw
INTEGER :: ie, if, nf, ne, idie, ig, ierr, i, nbt, nsst
INTEGER :: ie, idf, nf, ne, idie, ig, ierr, i, nbt, nsst
COMPLEX(DP), ALLOCATABLE :: eforce(:,:)
REAL (DP), ALLOCATABLE :: bece(:,:)
REAL(DP) :: curr(3), currt, wef, w, wg2, p2
@ -151,10 +151,10 @@ CONTAINS
ef = ( ei_emp(1,iss) + ei(nf,iss) ) / 2.0
DO if = 1, nf
fi( if ) = 2.0 / nspin
eig( if ) = ei( if, iss )
! IF( ionode ) WRITE( stdout, fmt = '(I4,2F12.6)' ) if, fi(if), eig(if)
DO idf = 1, nf
fi( idf ) = 2.0 / nspin
eig( idf ) = ei( idf, iss )
! IF( ionode ) WRITE( stdout, fmt = '(I4,2F12.6)' ) idf, fi(idf), eig(idf)
END DO
DO ie = nf+1, ne+nf
@ -163,13 +163,13 @@ CONTAINS
! IF( ionode ) WRITE( stdout, fmt = '(I4,2F12.6)' ) ie, fi(ie), eig(ie)
END DO
DO if = 1, nf
DO idf = 1, nf
!
DO ie = nf + 1, (nf + ne)
! frequencies in atomic units
!
wef = eig(ie) - eig(if)
wef = eig(ie) - eig(idf)
!
! discretize the frequency
!
@ -178,7 +178,7 @@ CONTAINS
IF( wef > eps8 ) THEN
cie = ie-nf
cif = if
cif = idf
ccurr = 0.0d0
@ -199,15 +199,15 @@ CONTAINS
!
curr = AIMAG( ccurr )
!
!dipole( :, if, ie, iss ) = wg2 * tpiba2 * DBLE( ccurr(:) * CONJG( ccurr(:) ) )
!dipole( :, ie, if, iss ) = wg2 * tpiba2 * DBLE( ccurr(:) * CONJG( ccurr(:) ) )
dipole( :, if, ie, iss ) = wg2 * tpiba2 * curr(:)**2
dipole( :, ie, if, iss ) = wg2 * tpiba2 * curr(:)**2
!dipole( :, idf, ie, iss ) = wg2 * tpiba2 * DBLE( ccurr(:) * CONJG( ccurr(:) ) )
!dipole( :, ie, idf, iss ) = wg2 * tpiba2 * DBLE( ccurr(:) * CONJG( ccurr(:) ) )
dipole( :, idf, ie, iss ) = wg2 * tpiba2 * curr(:)**2
dipole( :, ie, idf, iss ) = wg2 * tpiba2 * curr(:)**2
!
p2 = DBLE( dipole( 1, if, ie, iss ) + dipole( 2, if, ie, iss ) + dipole( 3, if, ie, iss ) )
p2 = DBLE( dipole( 1, idf, ie, iss ) + dipole( 2, idf, ie, iss ) + dipole( 3, idf, ie, iss ) )
!
!
currt = wg2 * (fi(if)-fi(ie)) * ( curr(1)**2 + curr(2)**2 + curr(3)**2 )
currt = wg2 * (fi(idf)-fi(ie)) * ( curr(1)**2 + curr(2)**2 + curr(3)**2 )
currt = currt * tpiba2 / wef
!
! update dielectric tensor
@ -217,10 +217,10 @@ CONTAINS
diet(idie) = diet(idie) + CMPLX(0.0d0, currt) / wef
sigma(idie) = sigma(idie) + currt
ndiet(idie) = ndiet(idie) + 1
epsilon2(idie) = epsilon2(idie) + 4.0d0 * pi * pi * p2 * fi(if) / wef**2 / 3.0d0
epsilon2(idie) = epsilon2(idie) + 4.0d0 * pi * pi * p2 * fi(idf) / wef**2 / 3.0d0
END IF
sumrule = sumrule + fi(if) * 2.0d0 * dipole( :, if, ie, iss ) / wef
sumrule = sumrule + fi(idf) * 2.0d0 * dipole( :, idf, ie, iss ) / wef
END IF
!

10
D3/drho_cc.f90
View File

@ -29,17 +29,17 @@ subroutine drho_cc (iflag)
implicit none
integer :: iflag
real (DP) :: xq0 (3), scale
real (DP) :: xq0 (3), scalef
if (.not.nlcc_any) return
if (iflag.eq. - 1) then
scale = - 1.d0
scalef = - 1.d0
else
scale = 1.d0
scalef = 1.d0
end if
xq0 = 0.d0
call drho_drc (iud0rho, ug0, xq0, d0rc, scale)
if (.not.lgamma) call drho_drc (iudrho, u, xq, drc, scale)
call drho_drc (iud0rho, ug0, xq0, d0rc, scalef)
if (.not.lgamma) call drho_drc (iudrho, u, xq, drc, scalef)
return
end subroutine drho_cc

6
D3/drho_drc.f90
View File

@ -8,7 +8,7 @@
#include "f_defs.h"
!
!-----------------------------------------------------------------------
SUBROUTINE drho_drc (iudrho_x, u_x, xq_x, drc_x, scale)
SUBROUTINE drho_drc (iudrho_x, u_x, xq_x, drc_x, scalef)
!-----------------------------------------------------------------------
! Reads the variation of the charge saved on a file and changes
! it according to the variation of the core_charge
@ -26,7 +26,7 @@ SUBROUTINE drho_drc (iudrho_x, u_x, xq_x, drc_x, scale)
INTEGER :: iudrho_x
!input: the unit containing the charge variation
REAL (DP) :: xq_x (3), scale
REAL (DP) :: xq_x (3), scalef
!input: q point
!input: drhocore will be added to the valence charge scaled by this factor
COMPLEX (DP) :: u_x (3 * nat, 3 * nat), drc_x (ngm, ntyp)
@ -69,7 +69,7 @@ SUBROUTINE drho_drc (iudrho_x, u_x, xq_x, drc_x, scale)
CALL cft3 (drhoc, nr1, nr2, nr3, nrx1, nrx2, nrx3, + 1)
CALL davcio_drho2 (drhov, lrdrho, iudrho_x, ipert, - 1)
drhov(:) = drhov(:) + scale * drhoc(:)
drhov(:) = drhov(:) + scalef * drhoc(:)
CALL davcio_drho2 (drhov, lrdrho, iudrho_x, ipert, + 1)
ENDDO

2
Modules/constants.f90
View File

@ -70,7 +70,7 @@ MODULE constants
!
REAL(DP), PARAMETER :: DEBYE_SI = 3.3356409519 * 1.0D-30 ! C*m
REAL(DP), PARAMETER :: AU_DEBYE = ELECTRON_SI * BOHR_RADIUS_SI / &
DEBYE_SI
DEBYE_SI
!
REAL(DP), PARAMETER :: eV_to_kelvin = ELECTRONVOLT_SI / K_BOLTZMANN_SI
REAL(DP), PARAMETER :: ry_to_kelvin = RYDBERG_SI / K_BOLTZMANN_SI

16
Modules/ptoolkit.f90
View File

@ -98,7 +98,7 @@
!
REAL(DP) :: DDOT
!
REAL(DP) :: g, scale, sigma, kappa, f, h, tmp
REAL(DP) :: g, scalef, sigma, kappa, f, h, tmp
REAL(DP), ALLOCATABLE :: u(:)
REAL(DP), ALLOCATABLE :: p(:)
REAL(DP), ALLOCATABLE :: vtmp(:)
@ -139,20 +139,20 @@
IF ( L > 1 ) THEN
SCALE = 0.0D0
SCALEF = 0.0D0
DO K = 1, is(l)
SCALE = SCALE + DABS( A(K,I) )
SCALEF = SCALEF + DABS( A(K,I) )
END DO
#if defined __PARA
# if defined __MPI
redin(1) = scale
redin(1) = scalef
CALL MPI_ALLREDUCE(redin, redout, 1, MPI_DOUBLE_PRECISION, MPI_SUM, comm, IERR)
SCALE = redout(1)
SCALEF = redout(1)
# endif
#endif
IF ( SCALE .EQ. 0.0D0 ) THEN
IF ( SCALEF .EQ. 0.0D0 ) THEN
IF (RI(L).EQ.ME) THEN
E(I) = A(is(L),I)
END IF
@ -160,7 +160,7 @@
! ...... CALCOLO DI SIGMA E DI H
ONE_OVER_SCALE = 1.0d0/SCALE
ONE_OVER_SCALE = 1.0d0/SCALEF
SIGMA = 0.0D0
DO k = 1,is(L)
A(k,I) = A(k,I) * ONE_OVER_SCALE
@ -186,7 +186,7 @@
G = -SIGN(SQRT(SIGMA),F)
H = SIGMA - F*G
ONE_OVER_H = 1.0d0/H
E(I) = SCALE*G
E(I) = SCALEF*G
! ...... COSTRUZIONE DEL VETTORE U

4
Modules/read_namelists.f90
View File

@ -83,9 +83,9 @@ MODULE read_namelists_module
!
! ... directory containing the pseudopotentials
!
CALL getenv( 'ESPRESSO_PSEUDO', pseudo_dir )
CALL get_env( 'ESPRESSO_PSEUDO', pseudo_dir )
IF ( TRIM( pseudo_dir ) == ' ') THEN
CALL getenv( 'HOME', pseudo_dir )
CALL get_env( 'HOME', pseudo_dir )
pseudo_dir = TRIM( pseudo_dir ) // '/espresso/pseudo/'
END IF
!

22
PP/qexml.f90
View File

@ -156,34 +156,34 @@ CONTAINS
!-------------------------------------------
!
!------------------------------------------------------------------------
FUNCTION int_to_char( int )
FUNCTION int_to_char( i )
!------------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: int
INTEGER, INTENT(IN) :: i
CHARACTER (LEN=6) :: int_to_char
!
!
IF ( int < 10 ) THEN
IF ( i < 10 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I1)" ) int
WRITE( UNIT = int_to_char , FMT = "(I1)" ) i
!
ELSE IF ( int < 100 ) THEN
ELSE IF ( i < 100 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I2)" ) int
WRITE( UNIT = int_to_char , FMT = "(I2)" ) i
!
ELSE IF ( int < 1000 ) THEN
ELSE IF ( i < 1000 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I3)" ) int
WRITE( UNIT = int_to_char , FMT = "(I3)" ) i
!
ELSE IF ( int < 10000 ) THEN
ELSE IF ( i < 10000 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I4)" ) int
WRITE( UNIT = int_to_char , FMT = "(I4)" ) i
!
ELSE
!
WRITE( UNIT = int_to_char , FMT = "(I5)" ) int
WRITE( UNIT = int_to_char , FMT = "(I5)" ) i
!
END IF
!

15
VIB/Makefile
View File

@ -2,15 +2,20 @@
.PHONY : cpvib.x pwvib.x
all : cpvib pwvib
include ../make.sys
cpvib : cpvib.x
TLDEPS=bindir mods libs libiotk pw cp
all : tldeps cpvib.x pwvib.x
tldeps:
test -n "$(TLDEPS)" && ( cd .. ; $(MAKE) $(MFLAGS) $(TLDEPS) || exit 1) || :
cpvib.x :
$(MAKE) -f makefile.cpvib
$(MAKE) -f makefile.cpvib DFLAGS='$(DFLAGS) -DDFT_CP'
pwvib : pwvib.x
pwvib.x :
$(MAKE) -f makefile.pwvib
$(MAKE) -f makefile.pwvib DFLAGS='$(DFLAGS) -DDFT_PW'
clean :
- /bin/rm -f cpvib.x pwvib.x *.o *.mod version.h *.i core* *.F90 fort* \

7
VIB/makefile.cpvib
View File

@ -78,16 +78,11 @@ MODULES = \
../Modules/wave_base.o \
../Modules/xml_io_base.o
.f90.o:
$(MPIF90) $(F90FLAGS) -DDFT_CP -c $<
WRAPPERS = wrapper.o
all : cpvib.x
cpvib: cpvib.x
#cpvib.x : FFLAGS += -DDFT_CP
cpvib.x : cleancp $(CP_OBJS) $(VIB_OBJ) $(LIBOBJS) ../CPV/cp.x vibstart.o
cpvib.x : cleancp $(CP_OBJS) $(VIB_OBJ) $(LIBOBJS) vibstart.o
$(MPIF90) $(LDFLAGS) -o cpvib.x -I../CPV \
vibstart.o $(VIB_OBJ) $(MODULES) $(CP_OBJS) \
$(LIBOBJS) $(LIBS)

7
VIB/makefile.pwvib
View File

@ -78,15 +78,10 @@ MODULES = \
../Modules/wave_base.o \
../Modules/xml_io_base.o
.f90.o:
$(MPIF90) $(F90FLAGS) -DDFT_PW -c $<
WRAPPERS = wrapper.o
all : pwvib.x
pwvib: pwvib.x
#pwvib.x : FFLAGS += -DDFT_PW
pwvib.x : cleanpw $(PW_OBJS) $(VIB_OBJ) $(LIBOBJS) ../PW/pw.x vibstart.o
pwvib.x : cleanpw $(PW_OBJS) $(VIB_OBJ) $(LIBOBJS) vibstart.o
$(MPIF90) $(LDFLAGS) -o pwvib.x -I../PW \
vibstart.o $(VIB_OBJ) $(MODULES) $(PW_OBJS) \
$(LIBOBJS) $(LIBS)

22
flib/int_to_char.f90
View File

@ -1,32 +1,32 @@
!-----------------------------------------------------------------------
FUNCTION int_to_char( int )
FUNCTION int_to_char( i )
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: int
INTEGER, INTENT(IN) :: i
CHARACTER (LEN=6) :: int_to_char
!
!
IF ( int < 10 ) THEN
IF ( i < 10 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I1)" ) int
WRITE( UNIT = int_to_char , FMT = "(I1)" ) i
!
ELSE IF ( int < 100 ) THEN
ELSE IF ( i < 100 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I2)" ) int
WRITE( UNIT = int_to_char , FMT = "(I2)" ) i
!
ELSE IF ( int < 1000 ) THEN
ELSE IF ( i < 1000 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I3)" ) int
WRITE( UNIT = int_to_char , FMT = "(I3)" ) i
!
ELSE IF ( int < 10000 ) THEN
ELSE IF ( i < 10000 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I4)" ) int
WRITE( UNIT = int_to_char , FMT = "(I4)" ) i
!
ELSE
!
WRITE( UNIT = int_to_char , FMT = "(I5)" ) int
WRITE( UNIT = int_to_char , FMT = "(I5)" ) i
!
END IF
!

54
flib/sort.f90
View File

@ -414,7 +414,7 @@ end subroutine ihpsort
! ==--------------------------------------------------------------==
USE kinds
INTEGER :: N, MARK, I, M, LA, IS, IF, MLOOP, IFKA, IS1, J, INT, &
INTEGER :: N, MARK, I, M, LA, IS, IF, MLOOP, IFKA, IS1, J, IT, &
IY, INTEST, K, IFK, K1, IP, LNGTH
logical :: cpgt,cplt
@ -463,9 +463,9 @@ end subroutine ihpsort
50 AV=COUNT(I-1)
COUNT(I-1)=COUNT(I)
COUNT(I)=AV
INT=IDX(I-1)
IT=IDX(I-1)
IDX(I-1)=IDX(I)
IDX(I)=INT
IDX(I)=IT
I=I-1
IF(I.GT.IS)GOTO 40
60 CONTINUE
@ -569,7 +569,7 @@ end subroutine ihpsort
! ==--------------------------------------------------------------==
USE kinds
INTEGER :: N, I, M, LA, IS, IF, MLOOP, IFKA, IS1, J, INT, &
INTEGER :: N, I, M, LA, IS, IF, MLOOP, IFKA, IS1, J, IT, &
IY, INTEST, K, IFK, K1, IP, LNGTH
@ -616,9 +616,9 @@ end subroutine ihpsort
50 AV=COUNT(I-1)
COUNT(I-1)=COUNT(I)
COUNT(I)=AV
INT=IDX(I-1)
IT=IDX(I-1)
IDX(I-1)=IDX(I)
IDX(I)=INT
IDX(I)=IT
I=I-1
IF(I.GT.IS)GOTO 40
60 CONTINUE
@ -724,7 +724,7 @@ end subroutine ihpsort
! ==--------------------------------------------------------------==
USE kinds
INTEGER :: N, I, M, LA, IS, IF, MLOOP, IFKA, IS1, J, INT, &
INTEGER :: N, I, M, LA, IS, IF, MLOOP, IFKA, IS1, J, IT, &
IY, INTEST, K, IFK, K1, IP, LNGTH
REAL(DP) :: COUNT(*),AV,X
@ -770,9 +770,9 @@ end subroutine ihpsort
50 AV=COUNT(I-1)
COUNT(I-1)=COUNT(I)
COUNT(I)=AV
INT=IDX(I-1)
IT=IDX(I-1)
IDX(I-1)=IDX(I)
IDX(I)=INT
IDX(I)=IT
I=I-1
IF(I.GT.IS)GOTO 40
60 CONTINUE
@ -880,8 +880,8 @@ end subroutine ihpsort
integer :: n, idx(*)
real(8) :: count(*)
real(8) :: av, x
integer :: k1, ifk, lngth, ip, k, int, ifka, intest, iy
integer :: i, m, la, is, if, mloop, ifca, is1, j, mark(50)
integer :: k1, ifk, lngth, ip, k, it, ifka, intest, iy
integer :: i, m, la, is, idf, mloop, ifca, is1, j, mark(50)
! set index array to original order .
do i=1,n
idx(i)=i
@ -899,15 +899,15 @@ end subroutine ihpsort
! set up initial values.
la=2
is=1
if=n
idf=n
do 190 mloop=1,n
! if segment is short enough sort with final sorting routine .
ifka=if-is
ifka=idf-is
if((ifka+1).gt.m)goto 70
!********* final sorting ***
! ( a simple bubble sort )
is1=is+1
do 60 j=is1,if
do 60 j=is1,idf
i=j
40 if(count(i-1).lt.count(i))goto 60
if(count(i-1).gt.count(i))goto 50
@ -915,9 +915,9 @@ end subroutine ihpsort
50 av=count(i-1)
count(i-1)=count(i)
count(i)=av
int=idx(i-1)
it=idx(i-1)
idx(i-1)=idx(i)
idx(i)=int
idx(i)=it
i=i-1
if(i.gt.is)goto 40
60 continue
@ -927,20 +927,20 @@ end subroutine ihpsort
! select the number in the central position in the segment as
! the test number.replace it with the number from the segment's
! highest address.
70 iy=(is+if)/2
70 iy=(is+idf)/2
x=count(iy)
intest=idx(iy)
count(iy)=count(if)
idx(iy)=idx(if)
count(iy)=count(idf)
idx(iy)=idx(idf)
! the markers 'i' and 'ifk' are used for the beginning and end
! of the section not so far tested against the present value
! of x .
k=1
ifk=if
ifk=idf
! we alternate between the outer loop that increases i and the
! inner loop that reduces ifk, moving numbers and indices as
! necessary, until they meet .
do 110 i=is,if
do 110 i=is,idf
if(x.gt.count(i))goto 110
if(x.lt.count(i))goto 80
if(intest.gt.idx(i))goto 110
@ -949,7 +949,7 @@ end subroutine ihpsort
idx(ifk)=idx(i)
k1=k
do 100 k=k1,ifka
ifk=if-k
ifk=idf-k
if(count(ifk).gt.x)goto 100
if(count(ifk).lt.x)goto 90
if(intest.le.idx(ifk))goto 100
@ -973,23 +973,23 @@ end subroutine ihpsort
idx(i)=intest
ip=i
! store the longer subdivision in workspace.
140 if((ip-is).gt.(if-ip))goto 150
mark(la)=if
140 if((ip-is).gt.(idf-ip))goto 150
mark(la)=idf
mark(la-1)=ip+1
if=ip-1
idf=ip-1
goto 160
150 mark(la)=ip-1
mark(la-1)=is
is=ip+1
! find the length of the shorter subdivision.
160 lngth=if-is
160 lngth=idf-is
if(lngth.le.0)goto 180
! if it contains more than one element supply it with workspace .
la=la+2
goto 190
170 if(la.le.0)goto 10
! obtain the address of the shortest segment awaiting quicksort
180 if=mark(la)
180 idf=mark(la)
is=mark(la-1)
190 continue
10 return

30
pwtools/dist.f
View File

@ -36,7 +36,7 @@
character*80 filename, line
character*1 capital, other_cell(ndistx)
real*8 at(3,3), bg(3,3), celldm(6), omega, d(ndistx)
real*8 tau(3,nax), dr(3), dd, dn1, dn2, dn3, dmin, dmax, scale
real*8 tau(3,nax), dr(3), dd, dn1, dn2, dn3, dmin, dmax, scalef
real*8 angolo(nnx*(nnx-1)/2), drv(3), drn(3,nnx), temp, rtemp(3)
real*8 fact, pi
parameter (fact=0.529177d0, pi=3.141592653589793d0)
@ -88,25 +88,25 @@
end do
if (matches('ATOMIC_POSITIONS',line)) then
if ( matches('ALAT', line) ) then
scale = 1.d0
scalef = 1.d0
crys = .false.
else if ( matches('BOHR', line) ) then
scale = celldm(1)
scalef = celldm(1)
crys = .false.
else if ( matches('CRYSTAL', line) ) then
scale = 1.d0
scalef = 1.d0
crys = .true.
else if ( matches('ANGSTROM', line) ) then
scale = celldm(1) * fact
scalef = celldm(1) * fact
crys = .false.
else
scale = 1.d0
scalef = 1.d0
crys = .false.
end if
else
read(line,*) scale
read(line,*) scalef
end if
if (scale.le.0.d0 .or. scale.gt.1000.d0) stop ' scale ! '
if (scalef.le.0.d0 .or. scalef.gt.1000.d0) stop ' scalef ! '
nsp = 0
do na=1,nat
@ -128,7 +128,7 @@
else
do na=1,nat
do i=1,3
tau(i,na)=tau(i,na)/scale
tau(i,na)=tau(i,na)/scalef
end do
end do
end if
@ -143,7 +143,7 @@
open(unit=1,file=filename,form='formatted')
end if
!
scale=fact*celldm(1)
scalef=fact*celldm(1)
30 continue
if (nsp.gt.1) then
do n = 1, nsp
@ -190,10 +190,10 @@
dn2=dr(2)-nn2
do nn3=-2,2
dn3=dr(3)-nn3
dd = scale* sqrt(
dd = scalef* sqrt(
& ( dn1*at(1,1)+dn2*at(1,2)+dn3*at(1,3) )**2+
& ( dn1*at(2,1)+dn2*at(2,2)+dn3*at(2,3) )**2+
& ( dn1*at(3,1)+dn2*at(3,2)+dn3*at(3,3) )**2)
& ( dn1*at(3,1)+dn2*at(3,2)+dn3*at(3,3) )**2)
if(dd.ge.dmin.and.dd.le.dmax) then
ndist=ndist+1
if (ndist.gt.ndistx) stop ' ndist !'
@ -260,7 +260,7 @@
dn2=dr(2)-nn2
do nn3=-1,1
dn3=dr(3)-nn3
dd = scale* sqrt(
dd = scalef* sqrt(
& ( dn1*at(1,1)+dn2*at(1,2)+dn3*at(1,3) )**2 +
& ( dn1*at(2,1)+dn2*at(2,2)+dn3*at(2,3) )**2 +
& ( dn1*at(3,1)+dn2*at(3,2)+dn3*at(3,3) )**2 )
@ -307,7 +307,7 @@
do nn1=1,nn
do nn2=nn1+1,nn
nd=nd+1
angolo(nd) = 360/(2*pi) * acos (scale**2 *
angolo(nd) = 360/(2*pi) * acos (scalef**2 *
& ( drn(1,nn1)*drn(1,nn2) +
& drn(2,nn1)*drn(2,nn2) +
& drn(3,nn1)*drn(3,nn2) ) / d(nn1) / d(nn2) )
@ -317,7 +317,7 @@
!
! dd is the distance from the origin
!
dd = sqrt(tau(1,na)**2 + tau(2,na)**2 + tau(3,na)**2)*scale
dd = sqrt(tau(1,na)**2 + tau(2,na)**2 + tau(3,na)**2)*scalef
write(iout,250) atm(ityp(na)), na, (d(nn1),nn1=1,nn)
write(iout,300) dd, (angolo(nn1),nn1=1,nn*(nn-1)/2)
!!! end if