diff --git a/PH/allocate_phq.f90 b/PH/allocate_phq.f90 index 6e4f9d0d9..1348dd12f 100644 --- a/PH/allocate_phq.f90 +++ b/PH/allocate_phq.f90 @@ -51,8 +51,8 @@ subroutine allocate_phq call mallocate(dyn , 3 * nat, 3 * nat) call mallocate(dyn00 , 3 * nat, 3 * nat) call mallocate(w2 , 3 * nat) - call mallocate(t ,3, 3, 48,3 * nat) - call mallocate(tmq ,3, 3, 3 * nat) + call mallocate(t ,max_irr_dim, max_irr_dim, 48,3 * nat) + call mallocate(tmq ,max_irr_dim, max_irr_dim, 3 * nat) call mallocate(npert , 3 * nat) call mallocate(zstareu ,3, 3, nat) call mallocate(zstareu0 ,3, 3 * nat) diff --git a/PH/intel.pcl b/PH/intel.pcl index 942c8b6fa..d063fc098 100644 --- a/PH/intel.pcl +++ b/PH/intel.pcl @@ -1,3 +1,3 @@ work.pc -/home/giannozz/O-sesame/Modules/work.pc -/home/giannozz/O-sesame/PW/work.pc +/home/stefano/newpw/O-sesame/Modules/work.pc +/home/stefano/newpw/O-sesame/PW/work.pc diff --git a/PH/phcom.f90 b/PH/phcom.f90 index d9bab2d86..269868a0e 100644 --- a/PH/phcom.f90 +++ b/PH/phcom.f90 @@ -30,10 +30,13 @@ module modes ! the possible G associated to each symmetry ! the G associated to the symmetry q<->-q+G + integer , parameter :: max_irr_dim = 4 ! maximal allowed dimension for + ! irreducible representattions + complex (kind=DP), pointer :: u (:,:), & ! 3 * nat, 3 * nat), ubar(:),& ! 3 * nat), & - t (:,:,:,:),& ! 3, 3, 48,3 * nat), - tmq (:,:,:) ! 3, 3, 3 * nat) + t (:,:,:,:),& ! max_irr_dim, max_irr_dim, 48,3 * nat), + tmq (:,:,:) ! max_irr_dim, max_irr_dim, 3 * nat) ! the transformation modes patterns ! the mode for deltarho ! the symmetry in the base of the pattern diff --git a/PH/phq_setup.f90 b/PH/phq_setup.f90 index a536384fa..62020bc51 100644 --- a/PH/phq_setup.f90 +++ b/PH/phq_setup.f90 @@ -218,16 +218,16 @@ subroutine phq_setup ! if such a symmetry has been found if (iswitch.eq. - 4) then call set_irr_mode (nat, at, bg, xq, s, invs, nsym, rtau, irt, & - irgq, nsymq, minus_q, irotmq, t, tmq, u, npert, nirr, gi, gimq, & + irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, nirr, gi, gimq, & iverbosity, modenum) else if (nsym.gt.1) then call set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & - irgq, nsymq, minus_q, irotmq, t, tmq, u, npert, nirr, gi, & + irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, nirr, gi, & gimq, iverbosity) else call set_irr_nosym (nat, at, bg, xq, s, invs, nsym, rtau, & - irt, irgq, nsymq, minus_q, irotmq, t, tmq, u, npert, nirr, & + irt, irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, nirr, & gi, gimq, iverbosity) endif endif diff --git a/PH/set_irr.f90 b/PH/set_irr.f90 index 983a49f2a..fc43b78ee 100644 --- a/PH/set_irr.f90 +++ b/PH/set_irr.f90 @@ -7,7 +7,7 @@ ! !--------------------------------------------------------------------- subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & - irgq, nsymq, minus_q, irotmq, t, tmq, u, npert, nirr, gi, gimq, & + irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, nirr, gi, gimq, & iverbosity) !--------------------------------------------------------------------- ! @@ -44,7 +44,7 @@ subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & ! integer :: nat, nsym, s (3, 3, 48), invs (48), irt (48, nat), & - iverbosity, npert (3 * nat), irgq (48), nsymq, irotmq, nirr + iverbosity, npert (3 * nat), irgq (48), nsymq, irotmq, nirr, max_irr_dim ! input: the number of atoms ! input: the number of symmetries ! input: the symmetry matrices @@ -66,8 +66,8 @@ subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & ! output: [S(irotq)*q - q] ! output: [S(irotmq)*q + q] - complex(kind=DP) :: u (3 * nat, 3 * nat), t (3, 3, 48, 3 * nat), & - tmq (3, 3, 3 * nat) + complex(kind=DP) :: u (3 * nat, 3 * nat), t (max_irr_dim, max_irr_dim, 48, 3 * nat), & + tmq (max_irr_dim, max_irr_dim, 3 * nat) ! output: the pattern vectors ! output: the symmetry matrices ! output: the matrice sending q -> -q+G @@ -211,8 +211,8 @@ subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & if (abs (eigen (imode) - eigen (imode-1) ) / (abs (eigen (imode) ) & + abs (eigen (imode-1) ) ) .lt.1.d-4) then npert (nirr) = npert (nirr) + 1 - if (npert (nirr) .gt.3) call error ('set_irr', 'npert > 3 ', & - nirr) + if (npert (nirr) .gt. max_irr_dim) call error & + ('set_irr', 'npert > max_irr_dim ', nirr) else nirr = nirr + 1 npert (nirr) = 1 @@ -223,8 +223,8 @@ subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & ! And we compute the matrices which represent the symmetry transformat ! in the basis of the displacements ! - call setv (2 * 3 * 3 * 48 * 3 * nat, 0.d0, t, 1) - call setv (2 * 3 * 3 * 3 * nat, 0.d0, tmq, 1) + call setv (2 * max_irr_dim * max_irr_dim * 48 * 3 * nat, 0.d0, t, 1) + call setv (2 * max_irr_dim * max_irr_dim * 3 * nat, 0.d0, tmq, 1) if (minus_q) then nsymtot = nsymq + 1 else @@ -333,8 +333,10 @@ subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & call mpi_bcast (gi, 144, MPI_REAL8, 0, MPI_COMM_WORLD, info) call mpi_bcast (gimq, 3, MPI_REAL8, 0, MPI_COMM_WORLD, info) !-complex*16 - call mpi_bcast (t, 2592 * nat, MPI_REAL8, 0, MPI_COMM_WORLD, info) - call mpi_bcast (tmq, 54 * nat, MPI_REAL8, 0, MPI_COMM_WORLD, info) + call mpi_bcast (t, 2 * max_irr_dim * max_irr_dim * 48 * 3 * nat, MPI_REAL8, & + 0, MPI_COMM_WORLD, info) + call mpi_bcast (tmq, 2 * max_irr_dim * max_irr_dim * 3 * nat, MPI_REAL8, & + 0, MPI_COMM_WORLD, info) call mpi_bcast (u, 18 * nat * nat, MPI_REAL8, 0, MPI_COMM_WORLD, & info) !-integer diff --git a/PH/set_irr_mode.f90 b/PH/set_irr_mode.f90 index a39802656..904ff7e63 100644 --- a/PH/set_irr_mode.f90 +++ b/PH/set_irr_mode.f90 @@ -8,7 +8,7 @@ ! !--------------------------------------------------------------------- subroutine set_irr_mode (nat, at, bg, xq, s, invs, nsym, rtau, & - irt, irgq, nsymq, minus_q, irotmq, t, tmq, u, npert, nirr, gi, & + irt, irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, nirr, gi, & gimq, iverbosity, modenum) !--------------------------------------------------------------------- ! @@ -33,7 +33,7 @@ subroutine set_irr_mode (nat, at, bg, xq, s, invs, nsym, rtau, & integer :: nat, nsym, s (3, 3, 48), invs (48), irt (48, nat), & iverbosity, modenum, npert (3 * nat), irgq (48), nsymq, irotmq, & - nirr + nirr, max_irr_dim ! input: the number of atoms ! input: the number of symmetries ! input: the symmetry matrices @@ -56,8 +56,8 @@ subroutine set_irr_mode (nat, at, bg, xq, s, invs, nsym, rtau, & ! output: [S(irotq)*q - q] ! output: [S(irotmq)*q + q] - complex(kind=DP) :: u (3 * nat, 3 * nat), t (3, 3, 48, 3 * nat), & - tmq (3, 3, 3 * nat) + complex(kind=DP) :: u (3 * nat, 3 * nat), t (max_irr_dim, max_irr_dim, 48, 3 * nat), & + tmq (max_irr_dim, max_irr_dim, 3 * nat) ! output: the pattern vectors ! output: the symmetry matrices ! output: the matrice sending q -> -q+G @@ -105,8 +105,7 @@ subroutine set_irr_mode (nat, at, bg, xq, s, invs, nsym, rtau, & ! ! find the small group of q ! - call smallgq (xq, at, bg, s, nsym, irgq, nsymq, irotmq, minus_q, & - gi, gimq) + call smallgq (xq, at, bg, s, nsym, irgq, nsymq, irotmq, minus_q, gi, gimq) ! ! set the modes to be done ! @@ -126,8 +125,8 @@ subroutine set_irr_mode (nat, at, bg, xq, s, invs, nsym, rtau, & ! And we compute the matrices which represent the symmetry transformat ! in the basis of the displacements ! - call setv (2 * 3 * 3 * 48 * 3 * nat, 0.d0, t, 1) - call setv (2 * 3 * 3 * 3 * nat, 0.d0, tmq, 1) + call setv (2 * max_irr_dim * max_irr_dim * 48 * 3 * nat, 0.d0, t, 1) + call setv (2 * max_irr_dim * max_irr_dim * 3 * nat, 0.d0, tmq, 1) if (minus_q) then nsymtot = nsymq + 1 else diff --git a/PH/set_irr_nosym.f90 b/PH/set_irr_nosym.f90 index fd550fb21..7e549611d 100644 --- a/PH/set_irr_nosym.f90 +++ b/PH/set_irr_nosym.f90 @@ -7,7 +7,7 @@ ! !--------------------------------------------------------------------- subroutine set_irr_nosym (nat, at, bg, xq, s, invs, nsym, rtau, & - irt, irgq, nsymq, minus_q, irotmq, t, tmq, u, npert, nirr, gi, & + irt, irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, nirr, gi, & gimq, iverbosity) !--------------------------------------------------------------------- ! @@ -31,7 +31,7 @@ include 'mpif.h' ! integer :: nat, nsym, s (3, 3, 48), invs (48), irt (48, nat), & - iverbosity, npert (3 * nat), irgq (48), nsymq, irotmq, nirr + iverbosity, npert (3 * nat), irgq (48), nsymq, irotmq, nirr, max_irr_dim ! input: the number of atoms ! input: the number of symmetries ! input: the symmetry matrices @@ -53,8 +53,8 @@ include 'mpif.h' ! output: [S(irotq)*q - q] ! output: [S(irotmq)*q + q] - complex(kind=DP) :: u (3 * nat, 3 * nat), t (3, 3, 48, 3 * nat), & - tmq (3, 3, 3 * nat) + complex(kind=DP) :: u (3 * nat, 3 * nat), t (max_irr_dim, max_irr_dim, 48, 3 * nat), & + tmq (max_irr_dim, max_irr_dim, 3 * nat) ! output: the pattern vectors ! output: the symmetry matrices ! output: the matrice sending q -> -q+G @@ -87,12 +87,12 @@ include 'mpif.h' ! And we compute the matrices which represent the symmetry transformat ! in the basis of the displacements ! - call setv (2 * 3 * 3 * 48 * 3 * nat, 0.d0, t, 1) + call setv (2 * max_irr_dim * max_irr_dim * 48 * 3 * nat, 0.d0, t, 1) - call setv (2 * 3 * 3 * 3 * nat, 0.d0, tmq, 1) + call setv (2 * max_irr_dim * max_irr_dim * 3 * nat, 0.d0, tmq, 1) do imode = 1, 3 * nat t (1, 1, 1, imode) = (1.d0, 0.d0) - enddo + return end subroutine set_irr_nosym diff --git a/PH/solve_e.f90 b/PH/solve_e.f90 index 4ed2c3db5..f3500c91e 100644 --- a/PH/solve_e.f90 +++ b/PH/solve_e.f90 @@ -324,7 +324,7 @@ subroutine solve_e & '' av.it.: '',f5.1)') iter, averlt dr2 = dr2 / 3 write (6, '(5x,'' thresh='',e10.3, '' alpha_mix = '',f6.3, & - & ''|ddv_scf|^2 = '',e10.3 )') thresh, alpha_mix (kter), dr2 + & '' |ddv_scf|^2 = '',e10.3 )') thresh, alpha_mix (kter), dr2 #ifdef FLUSH call flush (6) #endif