! ! Copyright (C) 2003-2009 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, ! or http://www.gnu.org/copyleft/gpl.txt . ! !---------------------------------------------------------------------------- SUBROUTINE output_tau( print_lattice, print_final ) !---------------------------------------------------------------------------- ! USE io_global, ONLY : stdout USE kinds, ONLY : DP USE constants, ONLY : bohr_radius_angs USE cell_base, ONLY : alat, at, bg, omega, ibrav USE ions_base, ONLY : nat, tau, ityp, atm, if_pos, tau_format ! IMPLICIT NONE ! LOGICAL, INTENT(IN) :: print_lattice, print_final REAL (DP), ALLOCATABLE :: tau_out(:,:) INTEGER :: na, i, k REAL(DP) :: term1sq, term2sq, term3sq, c, cell_edge, tx, ty, tz, c_tz, c_ty ! ! ! ... tau in output format ! ALLOCATE( tau_out(3,nat) ) ! tau_out(:,:) = tau(:,:) ! ! ... print cell parameters if required ! IF ( print_final ) WRITE( stdout, '("Begin final coordinates")') IF ( print_lattice ) THEN WRITE( stdout, * ) WRITE( stdout, '("New celldm() values")') WRITE( stdout, * ) ! if (ibrav == 0) then WRITE( stdout, * ) ' NOT IMPLEMENTED' else if (ibrav == 1) then ! ! simple cubic lattice ! cell_edge=at(1,1)*alat WRITE( stdout, * ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, * ) else if (ibrav == 2) then cell_edge=2*at(3,1)*alat WRITE( stdout, * ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, * ) else if (ibrav == 3) then cell_edge=2*at(1,1)*alat WRITE( stdout, * ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, * ) else if (ibrav == 4) then cell_edge=alat*at(1,1) WRITE( stdout, '(a,2F14.9)' ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, '(a,F14.9)' ) ' celldm(3) =', at(3,3) WRITE( stdout, * ) else if (ibrav == 5) then c=1-2*(at(1,1))**2 c_ty=(-6*at(2,1)**2)+1 c_tz=(3*at(3,1)**2-1)/2 cell_edge=alat*sqrt(at(1,1)**2+at(2,1)**2+at(3,1)**2) tx=sqrt((1-c)/2) ty=sqrt((1-c)/6) tz=sqrt((1+2*c)/3) WRITE( stdout, '(a,2F14.9)' ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, '(a,F14.9)' ) ' celldm(4) =', c WRITE( stdout, '(a,2F14.9)' ) ' |tx| =', tx, at(1,1) WRITE( stdout, '(a,2F14.9)' ) ' |ty| =', ty, -at(2,1) WRITE( stdout, '(a,2F14.9)' ) ' |tz| =', tz, at(3,1) WRITE( stdout, '(a,F14.9)' ) ' |c_tx| =', c WRITE( stdout, '(a,F14.9)' ) ' |c_ty| =', c_ty WRITE( stdout, '(a,F14.9)' ) ' |c_tz| =', c_tz WRITE( stdout, * ) else if (ibrav == 6) then cell_edge=alat*at(1,1) WRITE( stdout, '(a,2F14.9)' ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, '(a,2F14.9)' ) ' celldm(3) =', at(3,3) WRITE( stdout, * ) else if (ibrav == 7) then cell_edge=2*alat*at(1,1) WRITE( stdout, * ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, * ) ' celldm(3) =', at(3,3) WRITE( stdout, * ) else if (ibrav == 8) then cell_edge=alat*at(1,1) WRITE( stdout, * ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, * ) ' celldm(2) =', at(2,2)/at(1,1) WRITE( stdout, * ) ' celldm(3) =', at(3,3)/at(1,1) WRITE( stdout, * ) else if (ibrav == 9) then cell_edge=2*alat*at(1,1) WRITE( stdout, * ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, * ) ' celldm(2) =', at(2,1)/at(1,1) WRITE( stdout, * ) ' celldm(3) =', at(3,3)/(2*alat*at(1,1)) WRITE( stdout, * ) else if (ibrav == 10) then cell_edge=2*alat*at(1,1) WRITE( stdout, * ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, * ) ' celldm(2) =', at(2,2)/at(1,1) WRITE( stdout, * ) ' celldm(3) =', at(3,3)/at(1,1) WRITE( stdout, * ) else if (ibrav == 11) then cell_edge=2*alat*at(1,1) WRITE( stdout, * ) ' celldm(1) =', cell_edge, cell_edge*bohr_radius_angs WRITE( stdout, * ) ' celldm(2) =', at(2,1)/at(1,1) WRITE( stdout, * ) ' celldm(3) =', at(3,1)/at(1,1) WRITE( stdout, * ) ! sino a qui รจ tutto ok MZV else if (ibrav == 12) then WRITE( stdout, * ) ' celldm(1) =', at(1,1) WRITE( stdout, * ) ' celldm(2) =', at(1,1) WRITE( stdout, * ) ' celldm(3) =', at(3,3)/at(1,1) WRITE( stdout, * ) ' celldm(4) =', at(1,1) WRITE( stdout, * ) else if (ibrav == 13) then WRITE( stdout, * ) ' celldm(1) =', at(1,1) WRITE( stdout, * ) ' celldm(2) =', at(1,1) WRITE( stdout, * ) ' celldm(3) =', at(1,1) WRITE( stdout, * ) ' celldm(4) =', at(1,1) WRITE( stdout, * ) else if (ibrav == 14) then WRITE( stdout, * ) ' celldm(1) =', at(1,1) WRITE( stdout, * ) ' celldm(2) =', at(1,1) WRITE( stdout, * ) ' celldm(3) =', at(1,1) WRITE( stdout, * ) ' celldm(4) =', at(1,1) WRITE( stdout, * ) ' celldm(5) =', at(1,1) WRITE( stdout, * ) ' celldm(6) =', at(1,1) WRITE( stdout, * ) end if WRITE( stdout, '(5x,a,1F12.5," a.u.^3 ( ",1F11.5," Ang^3 )")') & "new unit-cell volume = ",omega, omega*bohr_radius_angs**3 WRITE( stdout, '(/"CELL_PARAMETERS (alat=",f12.8,")")') alat WRITE( stdout, '(3F14.9)') ( ( at(i,k), i = 1, 3), k = 1, 3 ) ! END IF ! SELECT CASE( tau_format ) ! ! ... convert output atomic positions from internally used format ! ... (a0 units) to the same format used in input ! CASE( 'alat' ) ! WRITE( stdout, '(/"ATOMIC_POSITIONS (alat)")' ) ! CASE( 'bohr' ) ! WRITE( stdout, '(/"ATOMIC_POSITIONS (bohr)")' ) tau_out(:,:) = tau_out(:,:) * alat ! CASE( 'crystal' ) ! WRITE( stdout, '(/"ATOMIC_POSITIONS (crystal)")' ) ! call cryst_to_cart( nat, tau_out, bg, -1 ) ! CASE( 'angstrom' ) ! WRITE( stdout, '(/"ATOMIC_POSITIONS (angstrom)")' ) ! tau_out(:,:) = tau_out(:,:) * alat * bohr_radius_angs ! CASE DEFAULT ! WRITE( stdout, '(/"ATOMIC_POSITIONS")' ) ! END SELECT ! DO na = 1, nat ! IF ( ANY( if_pos(:,na) == 0 ) ) THEN WRITE( stdout,'(A3,3X,3F14.9,1X,3i4)') & atm(ityp(na)), tau_out(:,na), if_pos(:,na) ELSE WRITE( stdout,'(A3,3X,3F14.9)') & atm(ityp(na)), tau_out(:,na) END IF ! END DO ! IF ( print_final ) WRITE( stdout, '("End final coordinates")') WRITE( stdout, '(/)' ) ! DEALLOCATE( tau_out ) ! RETURN ! END SUBROUTINE output_tau