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

- fixed bug in the use of ityp varaible

This commit is contained in:
carcava 2020-01-05 10:21:04 +01:00
parent 89615282fe
commit d24182d65e
3 changed files with 15 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CPV/src/fromscra.f90
View File

@ -217,7 +217,7 @@ SUBROUTINE from_scratch( )
CALL compute_stress( stress, detot, h, omega )
if( iverbosity > 1 ) &
CALL printout_pos( stdout, fion, nat, head = ' fion ' )
CALL printout_pos( stdout, fion, nat, ityp, head = ' fion ' )
CALL newd( vpot, irb, eigrb, becsum, fion )
!

18
CPV/src/print_out.f90
View File

@ -163,13 +163,13 @@
! ... write out a standard XYZ file in angstroms
!
IF(tstdout) &
CALL printout_pos( stdout, tau0, nat, what = 'pos', label = atm )
CALL printout_pos( stdout, tau0, nat, ityp, what = 'pos', label = atm )
!
IF( tfile ) then
if (.not.nice_output_files) then
CALL printout_pos( 35, tau0, nat, nfi = nfi, tps = tps )
CALL printout_pos( 35, tau0, nat, ityp, nfi = nfi, tps = tps )
else
CALL printout_pos( 35, tau0, nat, what = 'xyz', &
CALL printout_pos( 35, tau0, nat, ityp, what = 'xyz', &
nfi = nfi, tps = tps, label = atm, &
fact= BOHR_RADIUS_ANGS )
endif
@ -193,14 +193,14 @@
IF(tstdout) WRITE( stdout, * )
!
IF(tstdout) &
CALL printout_pos( stdout, tauw, nat, &
CALL printout_pos( stdout, tauw, nat, ityp, &
what = 'vel', label = atm )
!
IF( tfile ) then
if (.not.nice_output_files) then
CALL printout_pos( 34, tauw, nat, nfi = nfi, tps = tps )
CALL printout_pos( 34, tauw, nat, ityp, nfi = nfi, tps = tps )
else
CALL printout_pos( 34, tauw, nat, nfi = nfi, tps = tps, &
CALL printout_pos( 34, tauw, nat, ityp, nfi = nfi, tps = tps, &
what = 'vel', label = atm )
endif
END IF
@ -210,14 +210,14 @@
IF(tstdout) WRITE( stdout, * )
!
IF(tstdout) &
CALL printout_pos( stdout, fion, nat, &
CALL printout_pos( stdout, fion, nat, ityp, &
what = 'for', label = atm )
!
IF( tfile ) then
if (.not.nice_output_files) then
CALL printout_pos( 37, fion, nat, nfi = nfi, tps = tps )
CALL printout_pos( 37, fion, nat, ityp, nfi = nfi, tps = tps )
else
CALL printout_pos( 37, fion, nat, nfi = nfi, tps = tps, &
CALL printout_pos( 37, fion, nat, ityp, nfi = nfi, tps = tps, &
what = 'for', label = atm )
endif
END IF

17
CPV/src/printout_base.f90
View File

@ -172,18 +172,17 @@ CONTAINS
END SUBROUTINE printout_base_close
SUBROUTINE printout_pos( iunit, tau, nat, what, nfi, tps, label, fact, sort, head )
SUBROUTINE printout_pos( iunit, tau, nat, ityp, what, nfi, tps, label, fact, head )
!
USE kinds
!
INTEGER, INTENT(IN) :: iunit, nat
INTEGER, INTENT(IN) :: iunit, nat, ityp(:)
REAL(DP), INTENT(IN) :: tau( :, : )
CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: what
INTEGER, INTENT(IN), OPTIONAL :: nfi
REAL(DP), INTENT(IN), OPTIONAL :: tps
CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: label( : )
REAL(DP), INTENT(IN), OPTIONAL :: fact
INTEGER, INTENT(IN), OPTIONAL :: sort( : )
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: head
!
INTEGER :: ia, k
@ -216,15 +215,9 @@ CONTAINS
END IF
!
IF( PRESENT( label ) ) THEN
IF( PRESENT( sort ) ) THEN
DO ia = 1, nat
WRITE( iunit, 255 ) label( sort(ia) ), ( f * tau(k, sort(ia) ),k = 1,3)
END DO
ELSE
DO ia = 1, nat
WRITE( iunit, 255 ) label(ia), ( f * tau(k,ia),k = 1,3)
END DO
END IF
DO ia = 1, nat
WRITE( iunit, 255 ) label(ityp(ia)), ( f * tau(k,ia),k = 1,3)
END DO
ELSE
DO ia = 1, nat
WRITE( iunit, 252 ) (tau(k,ia),k = 1,3)