Commit 2b1c3a67 authored by giannozz's avatar giannozz

Variable cell_symmetry removed. There is still a problem with electric fields.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/[email protected] c92efa57-630b-4861-b058-cf58834340f0
parent 77b61f67
......@@ -66,8 +66,7 @@ MODULE cp_restart
USE gvecw, ONLY : ngw, ngw_g, ecutwfc
USE gvect, ONLY : ig_l2g, mill
USE electrons_base, ONLY : nspin, nelt, nel, nudx
USE cell_base, ONLY : ibrav, alat, celldm, &
symm_type, s_to_r
USE cell_base, ONLY : ibrav, alat, celldm, s_to_r
USE ions_base, ONLY : nsp, nat, na, atm, zv, &
pmass, amass, iforce, ind_bck
USE funct, ONLY : get_dft_name, get_inlc
......@@ -347,8 +346,7 @@ MODULE cp_restart
!
CALL recips( a1, a2, a3, b1, b2, b3 )
!
CALL write_cell( ibrav, symm_type, &
celldm, alat, a1, a2, a3, b1, b2, b3, &
CALL write_cell( ibrav, celldm, alat, a1, a2, a3, b1, b2, b3, &
do_makov_payne, .FALSE., .FALSE. )
!
!-------------------------------------------------------------------------------
......@@ -947,8 +945,7 @@ MODULE cp_restart
USE gvecw, ONLY : ngw, ngw_g
USE electrons_base, ONLY : nspin, nbnd, nelt, nel, &
nupdwn, iupdwn, nudx
USE cell_base, ONLY : ibrav, alat, celldm, symm_type, &
s_to_r, r_to_s
USE cell_base, ONLY : ibrav, alat, celldm, s_to_r, r_to_s
USE ions_base, ONLY : nsp, nat, na, atm, zv, pmass, &
sort_tau, ityp, ions_cofmass
USE gvect, ONLY : ig_l2g, mill
......@@ -1018,7 +1015,6 @@ MODULE cp_restart
! ... variables read for testing pourposes
!
INTEGER :: ibrav_
CHARACTER(LEN=9) :: symm_type_
CHARACTER(LEN=3) :: atm_(ntypx)
INTEGER :: nat_, nsp_, na_
INTEGER :: nk_, ik_, nt_
......@@ -1139,8 +1135,7 @@ MODULE cp_restart
!
IF ( ionode ) THEN
!
CALL read_cell( ibrav_, symm_type_, celldm_, &
alat_, a1_, a2_, a3_, b1, b2, b3 )
CALL read_cell( ibrav_, celldm_, alat_, a1_, a2_, a3_, b1, b2, b3 )
!
CALL recips( a1_, a2_, a3_, b1, b2, b3 )
!
......@@ -2018,7 +2013,6 @@ MODULE cp_restart
REAL(DP) :: celldm_(6)
REAL(DP) :: a1_(3), a2_(3), a3_(3)
REAL(DP) :: b1_(3), b2_(3), b3_(3)
CHARACTER(LEN=9) :: symm_type_
!
!
dirname = restart_dir( tmp_dir, ndr )
......@@ -2094,8 +2088,7 @@ MODULE cp_restart
!
! ... MD steps have not been found, try to restart from cell data
!
CALL read_cell( ibrav_, symm_type_, celldm_, &
alat_, a1_, a2_, a3_, b1_, b2_, b3_ )
CALL read_cell( ibrav_, celldm_, alat_, a1_,a2_,a3_, b1_, b2_, b3_ )
!
ht(1,:) = a1_
ht(2,:) = a2_
......@@ -2134,12 +2127,10 @@ MODULE cp_restart
END SUBROUTINE cp_read_cell
!
!------------------------------------------------------------------------
SUBROUTINE read_cell( ibrav, symm_type, &
celldm, alat, a1, a2, a3, b1, b2, b3 )
SUBROUTINE read_cell( ibrav, celldm, alat, a1, a2, a3, b1, b2, b3 )
!------------------------------------------------------------------------
!
INTEGER, INTENT(OUT) :: ibrav
CHARACTER(LEN=*), INTENT(OUT) :: symm_type
REAL(DP), INTENT(OUT) :: celldm(6), alat
REAL(DP), INTENT(OUT) :: a1(3), a2(3), a3(3)
REAL(DP), INTENT(OUT) :: b1(3), b2(3), b3(3)
......@@ -2184,9 +2175,6 @@ MODULE cp_restart
ibrav = 14
END SELECT
!
IF ( ibrav == 0 ) &
CALL iotk_scan_dat( iunpun, "CELL_SYMMETRY", symm_type )
!
CALL iotk_scan_dat( iunpun, "LATTICE_PARAMETER", alat )
CALL iotk_scan_dat( iunpun, "CELL_DIMENSIONS", celldm(1:6) )
!
......
......@@ -830,7 +830,7 @@ MODULE input
USE constants, ONLY : amu_au, pi
!
USE input_parameters, ONLY: ibrav , celldm , trd_ht, dt, &
cell_symmetry, rd_ht, a, b, c, cosab, cosac, cosbc, ntyp , nat , &
rd_ht, a, b, c, cosab, cosac, cosbc, ntyp , nat , &
na_inp , sp_pos , rd_pos , rd_vel, atom_mass, atom_label, if_pos, &
atomic_positions, id_loc, sic, sic_epsilon, sic_rloc, ecutwfc, &
ecutrho, ecfixed, qcutz, q2sigma, tk_inp, wmass, &
......@@ -908,7 +908,7 @@ MODULE input
massa_totale = SUM( atom_mass(1:ntyp)*na_inp(1:ntyp) )
!
CALL cell_base_init( ibrav, celldm, a, b, c, cosab, cosac, cosbc, &
trd_ht, cell_symmetry, rd_ht, cell_units )
trd_ht, rd_ht, cell_units )
CALL cell_dyn_init ( trd_ht, rd_ht, wmass, massa_totale, press, &
cell_damping, greash, cell_dofree )
!
......
Incompatible changes in svn version:
* Options 'cubic'/'hexagonal' to CELL_PARAMETERS removed: it is no
longer useful, the code will anyway find the correct sym.ops.
* Options 'bohr'/'angstrom'/'alat' to CELL_PARAMETERS implemented
New in 4.3.2 version
* A few crystal lattices can be specified using the traditional
......
......@@ -19,8 +19,6 @@
!
! ibrav: index of the bravais lattice (see latgen.f90)
INTEGER :: ibrav
! symm_type: 'cubic' or 'hexagonal' when ibrav=0
CHARACTER(len=9) :: symm_type
! celldm: old-style parameters of the simulation cell (se latgen.f90)
REAL(DP) :: celldm(6) = (/ 0.0_DP,0.0_DP,0.0_DP,0.0_DP,0.0_DP,0.0_DP /)
! traditional crystallographic cell parameters (alpha=cosbc and so on)
......@@ -101,7 +99,7 @@
!------------------------------------------------------------------------------!
!
SUBROUTINE cell_base_init( ibrav_, celldm_, a_, b_, c_, cosab_, cosac_, &
cosbc_, trd_ht, cell_symmetry, rd_ht, cell_units )
cosbc_, trd_ht, rd_ht, cell_units )
!
! ... initialize cell_base module variables, set up crystal lattice
!
......@@ -110,7 +108,6 @@
INTEGER, INTENT(IN) :: ibrav_
REAL(DP), INTENT(IN) :: celldm_ (6)
LOGICAL, INTENT(IN) :: trd_ht
CHARACTER(LEN=*), INTENT(IN) :: cell_symmetry
REAL(DP), INTENT(IN) :: rd_ht (3,3)
CHARACTER(LEN=*), INTENT(IN) :: cell_units
REAL(DP), INTENT(IN) :: a_ , b_ , c_ , cosab_, cosac_, cosbc_
......@@ -161,7 +158,6 @@
END IF
at(:,:) = at(:,:) / alat
CALL volume( alat, at(1,1), at(1,2), at(1,3), omega )
symm_type = cell_symmetry
!
ELSE
! ... crystal lattice via celldm or crystallographica parameters
......
......@@ -1444,7 +1444,6 @@ MODULE input_parameters
! CELL_PARAMETERS
!
REAL(DP) :: rd_ht(3,3) = 0.0_DP
CHARACTER(len=80) :: cell_symmetry = 'none'
CHARACTER(len=80) :: cell_units = 'alat'
LOGICAL :: trd_ht = .false.
......
......@@ -1081,12 +1081,6 @@ CONTAINS
CALL errore( ' card_cell_parameters ', ' two occurrences', 2 )
ENDIF
!
IF ( matches( 'HEXAGONAL', input_line ) ) THEN
cell_symmetry = 'hexagonal'
ELSE
cell_symmetry = 'cubic'
ENDIF
!
IF ( matches( "BOHR", input_line ) ) THEN
cell_units = 'bohr'
ELSEIF ( matches( "ANGSTROM", input_line ) ) THEN
......
......@@ -189,7 +189,6 @@ CONTAINS
!
!
CASE ( 'CELL' )
CALL mp_bcast( cell_symmetry, ionode_id )
CALL mp_bcast( ibrav, ionode_id )
CALL mp_bcast( celldm, ionode_id )
CALL mp_bcast( A, ionode_id )
......@@ -378,20 +377,6 @@ CONTAINS
&card', ABS( ierr ) )
!
IF ( found ) THEN
!
CALL iotk_scan_attr( attr, 'sym', option, default='cubic', ierr = ierr )
IF ( ierr /= 0 ) CALL errore( 'card_xml_cell', 'error scanning sym &
&attribute of cell node', abs(ierr) )
!
IF ( trim(option) == 'hexagonal' ) THEN
!
cell_symmetry = 'hexagonal'
!
ELSE
!
cell_symmetry = 'cubic'
!
END IF
!
CALL iotk_scan_attr( attr, 'type', option, ierr = ierr )
IF ( ierr /= 0 ) CALL errore( 'card_xml_cell', 'error scanning type &
......
......@@ -743,13 +743,11 @@ MODULE xml_io_base
!
!
!------------------------------------------------------------------------
SUBROUTINE write_cell( ibrav, symm_type, &
celldm, alat, a1, a2, a3, b1, b2, b3, &
SUBROUTINE write_cell( ibrav, celldm, alat, a1, a2, a3, b1, b2, b3, &
do_mp, do_mt, do_esm )
!------------------------------------------------------------------------
!
INTEGER, INTENT(IN) :: ibrav
CHARACTER(LEN=*), INTENT(IN) :: symm_type
REAL(DP), INTENT(IN) :: celldm(6), alat
REAL(DP), INTENT(IN) :: a1(3), a2(3), a3(3)
REAL(DP), INTENT(IN) :: b1(3), b2(3), b3(3)
......@@ -807,8 +805,6 @@ MODULE xml_io_base
CALL iotk_write_dat( iunpun, &
"BRAVAIS_LATTICE", TRIM( bravais_lattice ) )
!
CALL iotk_write_dat( iunpun, "CELL_SYMMETRY", symm_type )
!
CALL iotk_write_attr( attr, "UNITS", "Bohr", FIRST = .TRUE. )
CALL iotk_write_dat( iunpun, "LATTICE_PARAMETER", alat, ATTR = attr )
!
......@@ -928,13 +924,12 @@ MODULE xml_io_base
END SUBROUTINE write_ions
!
!------------------------------------------------------------------------
SUBROUTINE write_symmetry( ibrav, symm_type, nrot, nsym, invsym, noinv, &
SUBROUTINE write_symmetry( ibrav, nrot, nsym, invsym, noinv, &
time_reversal, no_t_rev, ft, &
s, sname, irt, nat, t_rev )
!------------------------------------------------------------------------
!
INTEGER, INTENT(IN) :: ibrav, nrot, nsym
CHARACTER(LEN=*), INTENT(IN) :: symm_type
LOGICAL, INTENT(IN) :: invsym, noinv, time_reversal, no_t_rev
INTEGER, INTENT(IN) :: s(:,:,:), irt(:,:), nat, t_rev(:)
REAL(DP), INTENT(IN) :: ft(:,:)
......@@ -945,9 +940,6 @@ MODULE xml_io_base
!
CALL iotk_write_begin( iunpun, "SYMMETRIES" )
!
IF ( ibrav == 0 ) &
CALL iotk_write_dat( iunpun, "CELL_SYMMETRY", symm_type )
!
CALL iotk_write_dat( iunpun, "NUMBER_OF_SYMMETRIES", nsym )
CALL iotk_write_dat( iunpun, "NUMBER_OF_BRAVAIS_SYMMETRIES", nrot )
!
......@@ -1432,6 +1424,7 @@ MODULE xml_io_base
! ... these are k-points and weights in the Irreducible BZ
!
IF (present(nks_start).and.present(xk_start).and.present(wk_start)) THEN
!
CALL iotk_write_dat( iunpun, "STARTING_K-POINTS", nks_start )
!
DO ik = 1, nks_start
......
......@@ -92,7 +92,6 @@ end Module dynamical
logical :: xmldyn, lrigid, lraman
logical, external :: has_xml
integer :: ibrav, nqs
character(len=9) :: symm_type
integer, allocatable :: itau(:)
namelist /input/ amass, asr, axis, fildyn, filout, filmol, filxsf, q
!
......@@ -133,7 +132,7 @@ end Module dynamical
ALLOCATE (zstar(3,3,nat))
ALLOCATE (dchi_dtau(3,3,3,nat) )
CALL read_dyn_mat_header(ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, amass_, tau, ityp, &
celldm, at, bg, omega, atm, amass_, tau, ityp, &
m_loc, nqs, lrigid, eps0, zstar, lraman, dchi_dtau)
IF (nqs /= 1) CALL errore('dynmat','only q=0 matrix allowed',1)
a0=celldm(1) ! define alat
......@@ -225,7 +224,6 @@ end Module dynamical
character(len=80) :: line
real(DP) :: celldm(6), dyn0r(3,3,2)
integer :: ibrav, nt, na, nb, naa, nbb, i, j, k, ios
CHARACTER(len=9) :: symm_type
logical :: qfinito, noraman
!
!
......@@ -236,7 +234,6 @@ end Module dynamical
read(1,*) ntyp,nat,ibrav,celldm
!
if (ibrav==0) then
read(1,'(a)') symm_type
read(1,*) ((at(i,j),i=1,3),j=1,3)
end if
!
......
......@@ -20,7 +20,7 @@ subroutine dynmatrix
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau, atm, pmass, zv
USE io_global, ONLY : stdout
USE control_flags, ONLY : modenum
USE cell_base, ONLY : at, bg, celldm, ibrav, omega, symm_type
USE cell_base, ONLY : at, bg, celldm, ibrav, omega
USE symm_base, ONLY : s, sr, irt, nsym, time_reversal, invs
USE run_info, ONLY : title
USE dynmat, ONLY : dyn, w2
......@@ -148,11 +148,11 @@ subroutine dynmatrix
IF (imq==0) nqq=2*nq
IF (lgamma.AND.done_epsil.AND.done_zeu) THEN
CALL write_dyn_mat_header( fildyn, ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, pmass, tau, ityp, m_loc, &
celldm, at, bg, omega, atm, pmass, tau, ityp, m_loc, &
nqq, epsilon, zstareu, lraman, ramtns*omega/fpi*convfact)
ELSE
CALL write_dyn_mat_header( fildyn, ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, pmass, tau,ityp,m_loc,nqq)
celldm, at, bg, omega, atm, pmass, tau,ityp,m_loc,nqq)
ENDIF
ELSE
CALL write_old_dyn_mat(iudyn)
......@@ -234,7 +234,7 @@ end subroutine dynmatrix
! will be tested.
!
USE ions_base, ONLY : ntyp => nsp, nat, ityp, tau, atm, pmass
USE cell_base, ONLY : ibrav, celldm, at, symm_type
USE cell_base, ONLY : ibrav, celldm, at
USE run_info, ONLY : title
IMPLICIT NONE
......@@ -245,7 +245,6 @@ end subroutine dynmatrix
WRITE (iudyn, '(a)') title
WRITE (iudyn, '(i3,i5,i3,6f11.7)') ntyp, nat, ibrav, celldm
IF (ibrav==0) THEN
WRITE (iudyn,'(a)') symm_type
WRITE (iudyn,'(2x,3f15.9)') ((at(i,j),i=1,3),j=1,3)
END IF
DO nt = 1, ntyp
......
......@@ -37,12 +37,11 @@ MODULE io_dyn_mat
CONTAINS
!
SUBROUTINE write_dyn_mat_header( fildyn, ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, amass, tau, ityp, m_loc, &
celldm, at, bg, omega, atm, amass, tau, ityp, m_loc, &
nqs, epsil, zstareu, lraman, ramtns)
!
INTEGER, INTENT(IN) :: ntyp, nat, ibrav, nspin_mag, nqs
CHARACTER(LEN=256), INTENT(IN) :: fildyn
CHARACTER(LEN=9), INTENT(IN) :: symm_type
CHARACTER(LEN=3), INTENT(IN) :: atm(ntyp)
REAL(DP), INTENT(IN) :: celldm(6)
REAL(DP), INTENT(IN) :: at(3,3)
......@@ -89,7 +88,6 @@ MODULE io_dyn_mat
CALL iotk_write_dat(iunout, "BRAVAIS_LATTICE_INDEX", ibrav )
CALL iotk_write_dat(iunout, "SPIN_COMPONENTS", nspin_mag )
CALL iotk_write_dat(iunout, "CELL_DIMENSIONS", celldm )
CALL iotk_write_dat(iunout, "CELL_SYMMETRY", symm_type )
CALL iotk_write_dat(iunout, "AT", at, COLUMNS=3 )
CALL iotk_write_dat(iunout, "BG", bg, COLUMNS=3 )
CALL iotk_write_dat(iunout, "UNIT_CELL_VOLUME_AU", omega )
......@@ -287,12 +285,11 @@ MODULE io_dyn_mat
END SUBROUTINE read_dyn_mat_param
SUBROUTINE read_dyn_mat_header(ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, amass, tau, ityp, m_loc, &
celldm, at, bg, omega, atm, amass, tau, ityp, m_loc, &
nqs, lrigid, epsil, zstareu, lraman, ramtns)
INTEGER, INTENT(IN) :: ntyp, nat
INTEGER, INTENT(OUT) :: ibrav, nspin_mag, nqs
CHARACTER(LEN=9), INTENT(OUT) :: symm_type
CHARACTER(LEN=3), INTENT(OUT) :: atm(ntyp)
REAL(DP), INTENT(OUT) :: celldm(6)
REAL(DP), INTENT(OUT) :: at(3,3)
......@@ -318,7 +315,6 @@ MODULE io_dyn_mat
CALL iotk_scan_dat( iunout, "BRAVAIS_LATTICE_INDEX", ibrav )
CALL iotk_scan_dat( iunout, "SPIN_COMPONENTS", nspin_mag )
CALL iotk_scan_dat( iunout, "CELL_DIMENSIONS", celldm )
CALL iotk_scan_dat( iunout, "CELL_SYMMETRY", symm_type )
CALL iotk_scan_dat( iunout, "AT", at )
CALL iotk_scan_dat( iunout, "BG", bg )
CALL iotk_scan_dat( iunout, "UNIT_CELL_VOLUME_AU", omega )
......@@ -383,7 +379,6 @@ MODULE io_dyn_mat
CALL mp_bcast(ibrav,ionode_id)
CALL mp_bcast(nspin_mag,ionode_id)
CALL mp_bcast(celldm,ionode_id)
CALL mp_bcast(symm_type,ionode_id)
CALL mp_bcast(at,ionode_id)
CALL mp_bcast(bg,ionode_id)
CALL mp_bcast(omega,ionode_id)
......
......@@ -131,7 +131,6 @@ PROGRAM matdyn
INTEGER :: nr1, nr2, nr3, nsc, nk1, nk2, nk3, ntetra, ibrav
CHARACTER(LEN=256) :: flfrc, flfrq, flvec, fltau, fldos, filename
CHARACTER(LEN=10) :: asr
CHARACTER(LEN=9) :: symm_type
LOGICAL :: dos, has_zstar
COMPLEX(DP), ALLOCATABLE :: dyn(:,:,:,:), dyn_blk(:,:,:,:)
COMPLEX(DP), ALLOCATABLE :: z(:,:)
......@@ -247,7 +246,7 @@ PROGRAM matdyn
ALLOCATE (atm(ntyp_blk))
ALLOCATE (zeu(3,3,nat_blk))
CALL read_dyn_mat_header(ntyp_blk, nat_blk, ibrav, nspin_mag, &
celldm, at_blk, bg_blk, omega_blk, symm_type, atm, amass_blk, &
celldm, at_blk, bg_blk, omega_blk, atm, amass_blk, &
tau_blk, ityp_blk, m_loc, nqs, has_zstar, epsil, zeu )
alat=celldm(1)
call volume(alat,at_blk(1,1),at_blk(1,2),at_blk(1,3),omega_blk)
......@@ -256,7 +255,7 @@ PROGRAM matdyn
CALL read_ifc(nr1,nr2,nr3,nat_blk,frc)
ELSE
CALL readfc ( flfrc, nr1, nr2, nr3, epsil, nat_blk, &
ibrav, symm_type, alat, at_blk, ntyp_blk, &
ibrav, alat, at_blk, ntyp_blk, &
amass_blk, omega_blk, has_zstar)
ENDIF
!
......@@ -345,7 +344,7 @@ PROGRAM matdyn
nqx = nk1*nk2*nk3
ALLOCATE ( tetra(4,ntetra), q(3,nqx) )
CALL gen_qpoints (ibrav, at, bg, nat, tau, ityp, nk1, nk2, nk3, &
symm_type, ntetra, nqx, nq, q, tetra)
ntetra, nqx, nq, q, tetra)
ELSE
!
! read q-point list
......@@ -590,7 +589,7 @@ END PROGRAM matdyn
!
!-----------------------------------------------------------------------
SUBROUTINE readfc ( flfrc, nr1, nr2, nr3, epsil, nat, &
ibrav, symm_type, alat, at, ntyp, amass, omega, has_zstar )
ibrav, alat, at, ntyp, amass, omega, has_zstar )
!-----------------------------------------------------------------------
!
USE kinds, ONLY : DP
......@@ -610,7 +609,6 @@ SUBROUTINE readfc ( flfrc, nr1, nr2, nr3, epsil, nat, &
REAL(DP) amass(ntyp), amass_from_file, celldm(6), omega
INTEGER nt
CHARACTER(LEN=3) atm
CHARACTER(LEN=9) symm_type
!
!
IF (ionode) OPEN (unit=1,file=flfrc,status='old',form='formatted')
......@@ -620,7 +618,6 @@ SUBROUTINE readfc ( flfrc, nr1, nr2, nr3, epsil, nat, &
IF (ionode)THEN
READ(1,*) ntyp,nat,ibrav,(celldm(i),i=1,6)
if (ibrav==0) then
read(1,'(a)') symm_type
read(1,*) ((at(i,j),i=1,3),j=1,3)
end if
ENDIF
......@@ -629,7 +626,6 @@ SUBROUTINE readfc ( flfrc, nr1, nr2, nr3, epsil, nat, &
CALL mp_bcast(ibrav, ionode_id)
CALL mp_bcast(celldm, ionode_id)
IF (ibrav==0) THEN
CALL mp_bcast(symm_type, ionode_id)
CALL mp_bcast(at, ionode_id)
ENDIF
!
......@@ -1741,7 +1737,7 @@ END SUBROUTINE write_tau
!
!-----------------------------------------------------------------------
SUBROUTINE gen_qpoints (ibrav, at_, bg_, nat, tau, ityp, nk1, nk2, nk3, &
symm_type, ntetra, nqx, nq, q, tetra)
ntetra, nqx, nq, q, tetra)
!-----------------------------------------------------------------------
!
USE kinds, ONLY : DP
......@@ -1753,7 +1749,6 @@ SUBROUTINE gen_qpoints (ibrav, at_, bg_, nat, tau, ityp, nk1, nk2, nk3, &
! input
INTEGER :: ibrav, nat, nk1, nk2, nk3, ntetra, ityp(*)
REAL(DP) :: at_(3,3), bg_(3,3), tau(3,nat)
character(LEN=9) :: symm_type
! output
INTEGER :: nqx, nq, tetra(4,ntetra)
REAL(DP) :: q(3,nqx)
......
......@@ -17,13 +17,13 @@ SUBROUTINE open_dvscf_star_q( q_index )
! symmetry operations
! (iii) dumps it in a special directory
!
! Original routine written by Matteo Calandra and Gianni Profera,
! Original routine written by Matteo Calandra and Gianni Profeta,
! adapted to ldisp case, fractional translations and imq=.true.
! by Matteo. Calandra.
!
!-----------------------------------------------------------------------
USE kinds, ONLY : DP
USE cell_base, ONLY : omega,at, bg, celldm, ibrav, symm_type,tpiba2
USE cell_base, ONLY : omega,at, bg, celldm, ibrav, tpiba2
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau, atm, amass
USE wvfct, ONLY : npwx,npw,igk
USE symm_base, ONLY : s, ftau,nsym,irt, invs
......
......@@ -87,7 +87,6 @@ PROGRAM q2r
CHARACTER(len=20) :: crystal
CHARACTER(len=256) :: fildyn, filin, filj, filf, flfrc
CHARACTER(len=3) :: atm(ntypx)
CHARACTER(len=9) :: symm_type
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
LOGICAL :: lq, lrigid, lrigid1, lnogridinfo, xmldyn
......@@ -203,12 +202,11 @@ PROGRAM q2r
ENDIF
IF (ifile==1) THEN
CALL read_dyn_mat_header(ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, amass, tau, ityp, &
celldm, at, bg, omega, atm, amass, tau, ityp, &
m_loc, nqs, lrigid, epsil, zeu )
ELSE
CALL read_dyn_mat_header(ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, amass, tau, ityp, &
m_loc, nqs)
celldm, at, bg, omega, atm, amass, tau, ityp, m_loc, nqs)
ENDIF
ALLOCATE (phiq(3,3,nat,nat,nqs) )
DO iq=1,nqs
......@@ -221,7 +219,7 @@ PROGRAM q2r
CALL mp_bcast(ierr, ionode_id)
IF (ierr /= 0) CALL errore('q2r','file '//TRIM(filin)//' missing!',1)
CALL read_file (nqs, q, epsil, lrigid, &
ntyp, nat, ibrav, symm_type, celldm, at, atm, amass)
ntyp, nat, ibrav, celldm, at, atm, amass)
IF (ionode) CLOSE(unit=1)
ENDIF
IF (ifile == 1) THEN
......@@ -303,19 +301,17 @@ PROGRAM q2r
IF (xmldyn) THEN
IF (lrigid) THEN
CALL write_dyn_mat_header( flfrc, ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, amass, tau, ityp, &
celldm, at, bg, omega, atm, amass, tau, ityp, &
m_loc, nqs, epsil, zeu)
ELSE
CALL write_dyn_mat_header( flfrc, ntyp, nat, ibrav, nspin_mag, &
celldm, at, bg, omega, symm_type, atm, amass, tau, ityp, &
m_loc, nqs)
celldm, at, bg, omega, atm, amass, tau, ityp, m_loc, nqs)
ENDIF
CALL write_ifc(nr1,nr2,nr3,nat,phid)
ELSE IF (ionode) THEN
OPEN(unit=2,file=flfrc,status='unknown',form='formatted')
WRITE(2,'(i3,i5,i3,6f11.7)') ntyp,nat,ibrav,celldm
if (ibrav==0) then
write (2,'(a)') symm_type
write (2,'(2x,3f15.9)') ((at(i,j),i=1,3),j=1,3)
end if
DO nt = 1,ntyp
......@@ -523,7 +519,7 @@ END SUBROUTINE gammaq2r
!
!----------------------------------------------------------------------------
SUBROUTINE read_file( nqs, xq, epsil, lrigid, &
ntyp, nat, ibrav, symm_type, celldm, at, atm, amass )
ntyp, nat, ibrav, celldm, at, atm, amass )
!----------------------------------------------------------------------------
!
USE kinds, ONLY : DP
......@@ -540,7 +536,6 @@ SUBROUTINE read_file( nqs, xq, epsil, lrigid, &
REAL(DP) :: epsil(3,3)
REAL(DP) :: xq(3,48), celldm(6), at(3,3), amass(ntyp)
CHARACTER(LEN=3) atm(ntyp)
CHARACTER(LEN=9) symm_type
! local variables
INTEGER :: ntyp1,nat1,ibrav1,ityp1
INTEGER :: i, j, na, nb, nt, ios
......@@ -548,7 +543,6 @@ SUBROUTINE read_file( nqs, xq, epsil, lrigid, &
REAL(DP) :: phir(3),phii(3)
CHARACTER(LEN=75) :: line
CHARACTER(LEN=3) :: atm1
CHARACTER(LEN=9) symm_type1
LOGICAL, SAVE :: first =.TRUE.
!
IF (ionode) THEN
......@@ -562,7 +556,6 @@ SUBROUTINE read_file( nqs, xq, epsil, lrigid, &
IF (ionode) THEN
READ(1,*) ntyp,nat,ibrav,(celldm(i),i=1,6)
if (ibrav==0) then
read (1,'(a)') symm_type
read (1,*) ((at(i,j),i=1,3),j=1,3)
end if
END IF
......@@ -571,7 +564,6 @@ SUBROUTINE read_file( nqs, xq, epsil, lrigid, &
CALL mp_bcast(ibrav, ionode_id)
CALL mp_bcast(celldm, ionode_id)
IF (ibrav==0) THEN
CALL mp_bcast(symm_type, ionode_id)
CALL mp_bcast(at, ionode_id)
ENDIF
......@@ -614,10 +606,6 @@ SUBROUTINE read_file( nqs, xq, epsil, lrigid, &
CALL errore('read_file','wrong celldm',i)
END DO
if (ibrav==0) then
IF (ionode) read (1,*) symm_type1
CALL mp_bcast(symm_type1, ionode_id)
if (symm_type1 /= symm_type) &
CALL errore('read_file','wrong symm_type for ibrav=0',1)
IF (ionode) read (1,*) ((at1(i,j),i=1,3),j=1,3)
CALL mp_bcast(at1, ionode_id)
do i=1,3
......
......@@ -17,7 +17,7 @@ cgracsc.o \
compute_ppsi.o \
compute_sigma_avg.o \
cube.o \
cubicspinsym.o \
spinsym.o \
dosg.o \
do_initial_state.o \
do_shift_ew.o \
......@@ -25,7 +25,6 @@ d_matrix_nc.o \
d_matrix_so.o \
elf.o \
ggen1d.o \
hexspinsym.o \
local_dos.o \
local_dos_mag.o \
local_dos1d.o \
......
......@@ -13,7 +13,6 @@ SUBROUTINE d_matrix_nc (dy012, dy112, dy212, dy312)
! Provides symmetry operations in the (l, s) subspaces for l=0,1,2,3
!
USE kinds, ONLY: DP
USE cell_base, ONLY : ibrav, symm_type
USE symm_base, ONLY: nsym, sr
USE random_numbers, ONLY : randy
!
......@@ -52,35 +51,7 @@ SUBROUTINE d_matrix_nc (dy012, dy112, dy212, dy312)
!
! Here we find the true symmetries of the crystal
!
IF ( ibrav == 4 .or. ibrav == 5 ) THEN
!
! ... here the hexagonal or trigonal bravais lattice
!
CALL hexspinsym( s_spin )
!
ELSEIF ( ibrav >=1 .and. ibrav <= 14 ) THEN
!
! ... here for the cubic bravais lattice
!
CALL cubicspinsym( s_spin )
!
ELSEIF ( ibrav == 0 ) THEN
!
IF ( symm_type == 'cubic' ) THEN
!
CALL cubicspinsym( s_spin )
!
ELSEIF ( symm_type == 'hexagonal' ) THEN
!
CALL hexspinsym( s_spin )
!
ENDIF
!
ELSE
!
CALL errore( 'd_matrix_nc', 'wrong ibrav', 1 )
!
ENDIF
CALL spinsym( s_spin )
!
! randomly distributed points on a sphere
!
......
......@@ -14,7 +14,6 @@ SUBROUTINE d_matrix_so (dyj12, dyj32, dyj52, dyj72)
! subspaces
!
USE kinds, ONLY: DP
USE cell_base, ONLY : ibrav, symm_type
USE symm_base, ONLY: nsym, sr
USE spin_orb, ONLY : rot_ylm
USE random_numbers, ONLY : randy
......@@ -63,35 +62,7 @@ SUBROUTINE d_matrix_so (dyj12, dyj32, dyj52, dyj72)
!
! Here we find the true symmetries of the crystal
!
IF ( ibrav == 4 .or. ibrav == 5 ) THEN
!
! ... here the hexagonal or trigonal bravais lattice
!
CALL hexspinsym( s_spin )
!
ELSEIF ( ibrav >=1 .and. ibrav <= 14 ) THEN
!
! ... here for the cubic bravais lattice
!
CALL cubicspinsym( s_spin )
!
ELSEIF ( ibrav == 0 ) THEN
!
IF (