Bug fix: same problem as in previous commit, hopefully now solved.

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@11152 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
dalcorso 2014-09-05 14:52:35 +00:00
parent 55908a0bce
commit 01ef90464b
2 changed files with 16 additions and 10 deletions

View File

@ -252,7 +252,7 @@ SUBROUTINE iosys()
pot_extrapolation, wfc_extrapolation, &
w_1, w_2, trust_radius_max, trust_radius_min, &
trust_radius_ini, bfgs_ndim, rd_pos, sp_pos, &
rd_for, lsg
rd_for, rd_if_pos => if_pos, lsg
!
! ... CELL namelist
!
@ -1235,8 +1235,8 @@ SUBROUTINE iosys()
CALL errore('input','The option crystal_sg requires the space group &
&number',1 )
CALL sup_spacegroup(rd_pos,sp_pos,rd_for,space_group,nat,uniqueb,&
rhombohedral,origin_choice,ibrav_sg)
CALL sup_spacegroup(rd_pos,sp_pos,rd_for,rd_if_pos,space_group,nat,&
uniqueb,rhombohedral,origin_choice,ibrav_sg)
IF (ibrav==-1) THEN
ibrav=ibrav_sg
ELSEIF (ibrav /= ibrav_sg) THEN
@ -1475,7 +1475,7 @@ SUBROUTINE read_cards_pw ( psfile, tau_format )
USE ions_base, ONLY : if_pos_ => if_pos, amass, fixatom
USE control_flags, ONLY : textfor, tv0rd
USE wyckoff, ONLY : nattot, tautot, ityptot, extfortot, &
clean_spacegroup
if_postot, clean_spacegroup
!
IMPLICIT NONE
!
@ -1514,6 +1514,7 @@ SUBROUTINE read_cards_pw ( psfile, tau_format )
tau(:,:)=tautot(:,:)
ityp(:) = ityptot(:)
extfor(:,:) = extfortot(:,:)
if_pos_(:,:) = if_postot(:,:)
CALL clean_spacegroup()
ELSE
DO ia = 1, nat
@ -1521,6 +1522,7 @@ SUBROUTINE read_cards_pw ( psfile, tau_format )
tau(:,ia) = rd_pos(:,ia)
ityp(ia) = sp_pos(ia)
extfor(:,ia) = rd_for(:,ia)
if_pos_(:,ia) = if_pos(:,ia)
!
ENDDO
ENDIF
@ -1542,7 +1544,6 @@ SUBROUTINE read_cards_pw ( psfile, tau_format )
! ... if_pos whose value is 0 when the coordinate is to be kept fixed, 1
! ... otherwise.
!
if_pos_(:,:) = if_pos(:,1:nat)
fixatom = COUNT( if_pos_(1,:)==0 .AND. if_pos_(2,:)==0 .AND. if_pos_(3,:)==0 )
!
tau_format = trim( atomic_positions )

View File

@ -4,24 +4,26 @@ USE space_group, ONLY : sym_brav, find_equivalent_tau
IMPLICIT NONE
INTEGER :: nattot
REAL(DP), ALLOCATABLE :: tautot(:,:)
INTEGER, ALLOCATABLE :: ityptot(:), extfortot(:,:)
REAL(DP), ALLOCATABLE :: tautot(:,:), extfortot(:,:)
INTEGER, ALLOCATABLE :: ityptot(:), if_postot(:,:)
SAVE
PRIVATE
PUBLIC sup_spacegroup, clean_spacegroup, nattot, tautot, ityptot, extfortot
PUBLIC sup_spacegroup, clean_spacegroup, nattot, tautot, ityptot, extfortot, &
if_postot
CONTAINS
SUBROUTINE sup_spacegroup(tau,ityp,extfor,space_group_number,not_eq,uniqueb,&
rhombohedral,choice,ibrav)
SUBROUTINE sup_spacegroup(tau,ityp,extfor,if_pos,space_group_number,not_eq,&
uniqueb,rhombohedral,choice,ibrav)
INTEGER, INTENT(IN) :: space_group_number, choice
LOGICAL, INTENT (IN) :: uniqueb, rhombohedral
INTEGER, INTENT (INOUT) :: not_eq
INTEGER, INTENT(OUT) :: ibrav
REAL(DP), DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: tau, extfor
INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(IN) :: ityp
INTEGER, DIMENSION(:,:), ALLOCATABLE, INTENT(IN) :: if_pos
INTEGER :: i,k,l,n,sym_n
INTEGER,DIMENSION(:),allocatable :: msym_n
character(LEN=1) :: unique
@ -66,6 +68,7 @@ CONTAINS
ALLOCATE(tautot(3,nattot))
ALLOCATE(ityptot(nattot))
ALLOCATE(extfortot(3,nattot))
ALLOCATE(if_postot(3,nattot))
!conversione tra outco e tau
l=0
@ -79,6 +82,7 @@ CONTAINS
tautot(2,k+l)=outco(2,k,i)
tautot(3,k+l)=outco(3,k,i)
ityptot(k+l) = ityp(i)
if_postot(:,k+l) = if_pos(:,i)
extfortot(:,k+l) = extfor(:,i)
END DO
END DO
@ -95,6 +99,7 @@ SUBROUTINE clean_spacegroup
DEALLOCATE(tautot)
DEALLOCATE(ityptot)
DEALLOCATE(extfortot)
DEALLOCATE(if_postot)
RETURN
END SUBROUTINE clean_spacegroup