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

Remove allocate

This commit is contained in:
Samuel Ponce 2019-05-14 08:09:35 +01:00
parent edac3d551d
commit 94ed130b4f
4 changed files with 84 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
EPW/src/allocate_epwq.f90
View File

@ -1,63 +0,0 @@
!
! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino
! Copyright (C) 2007-2009 Jesse Noffsinger, Brad Malone, Feliciano Giustino
!
! 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 .
!
! Code adapted from PH/allocate_phq - Quantum-ESPRESSO group
! 09/2009 There is a lot of excess in this file.
!
!-----------------------------------------------------------------------
SUBROUTINE allocate_epwq
!-----------------------------------------------------------------------
!!
!! Dynamical allocation of arrays: quantities needed for the linear
!! response problem
!!
!! RM - Nov/Dec - 2014 - Imported the noncolinear case implemented by xlzhang
!! SP - 2016 - Updated for QE 5
!! RM - Jan 2019 - Updated based on QE 6.3
!!
USE ions_base, ONLY : nat, ntyp => nsp
USE pwcom, ONLY : nbnd, nspin
USE gvect, ONLY : ngm
USE noncollin_module, ONLY : noncolin, nspin_mag
USE spin_orb, ONLY : lspinorb
USE phus, ONLY : int1, int1_nc, int2, int2_so, &
int4, int4_nc, int5, int5_so, &
alphap
USE lrus, ONLY : becp1
USE elph2, ONLY : elph, el_ph_mat
USE becmod, ONLY : becp, allocate_bec_type
USE uspp_param, ONLY : nhm
USE uspp, ONLY : okvan, nkb
USE klist, ONLY : nks
USE fft_base, ONLY : dfftp
USE epwcom, ONLY : nstemp
!
IMPLICIT NONE
!
INTEGER :: ik
!! k-point
INTEGER :: ipol
!! Polarization index
!
! ALLOCATE space for the quantities needed in EPW
!
! SP: nrxx is not used in QE 5 ==> tg_nnr is the maximum among nnr
! This should have the same dim as nrxx had.
! ALLOCATE (dmuxc ( nrxx, nspin, nspin))
! SP: Again a new change in QE (03/08/2016)
! ALLOCATE (dmuxc ( dffts%tg_nnr, nspin, nspin))
! SP: Following new FFT restructuration from Aug. 2017 (SdG)
! nnr = local number of FFT grid elements ( ~nr1*nr2*nr3/nproc )
! nnr_tg = local number of grid elements for task group FFT ( ~nr1*nr2*nr3/proc3 )
! --> tg = task group
! ALLOCATE (dmuxc ( dffts%nnr, nspin, nspin))
!
!
RETURN
!
END SUBROUTINE allocate_epwq

2
EPW/src/io_scattering.f90
View File

@ -1,4 +1,4 @@
!iufilibtev_sup
!
! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino
!
! This file is distributed under the terms of the GNU General Public

94
EPW/src/print_ibte.f90
View File

@ -480,43 +480,39 @@
lrepmatw3 = lrepmatw4 + &
INT(SUM(ind(1:my_pool_id + 1)) - ind(my_pool_id + 1), kind = MPI_OFFSET_KIND) * 4_MPI_OFFSET_KIND
!
CALL MPI_FILE_SEEK(iunepmat, lrepmatw,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunepmat, trans_prob, lsize, MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
!CALL MPI_FILE_SEEK(iunepmat, lrepmatw,MPI_SEEK_SET,ierr)
!IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
!CALL MPI_FILE_WRITE(iunepmat, trans_prob, lsize, MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,ierr)
!IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunepmat, lrepmatw, trans_prob, lsize, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparseq, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparseq, sparse_q, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
!CALL MPI_FILE_SEEK (iunsparseq, lrepmatw3,MPI_SEEK_SET,ierr)
!IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
!CALL MPI_FILE_WRITE(iunsparseq, sparse_q, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
!IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparseq, lrepmatw3, sparse_q, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparsek, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparsek, sparse_k, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparsek, lrepmatw3, sparse_k, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparsei, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparsei, sparse_i, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparsei, lrepmatw3, sparse_i, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparsej, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparsej, sparse_j, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparsej, lrepmatw3, sparse_j, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparset, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparset, sparse_t, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparset, lrepmatw3, sparse_t, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
! Offset for the next q iteration
lrepmatw2 = lrepmatw2 + INT(SUM(ind(:)), kind = MPI_OFFSET_KIND ) * 8_MPI_OFFSET_KIND
lrepmatw4 = lrepmatw4 + INT(SUM(ind(:)), kind = MPI_OFFSET_KIND ) * 4_MPI_OFFSET_KIND
!
! now write in the support file
CALL mp_sum(xkf_all, world_comm)
CALL mp_sum(wkf_all, world_comm)
CALL MP_SUM(xkf_all, world_comm)
CALL MP_SUM(wkf_all, world_comm)
!
ENDIF
IF ( sum(indcb) > 0 ) THEN
@ -535,35 +531,23 @@
lrepmatw3 = lrepmatw6 + &
INT(SUM(indcb(1:my_pool_id + 1)) - indcb(my_pool_id + 1), kind = MPI_OFFSET_KIND) * 4_MPI_OFFSET_KIND
!
CALL MPI_FILE_SEEK(iunepmatcb, lrepmatw,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunepmatcb, trans_probcb, lsize, MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunepmatcb, lrepmatw, trans_probcb, lsize, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparseqcb, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparseqcb, sparsecb_q, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparseqcb, lrepmatw3, sparsecb_q, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparsekcb, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparsekcb, sparsecb_k, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparsekcb, lrepmatw3, sparsecb_k, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparseicb, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparseicb, sparsecb_i, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparseicb, lrepmatw3, sparsecb_i, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparsejcb, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparsejcb, sparsecb_j, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparsejcb, lrepmatw3, sparsecb_j, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
CALL MPI_FILE_SEEK (iunsparsetcb, lrepmatw3,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_WRITE(iunsparsetcb, sparsecb_t, lsize, MPI_INTEGER4,MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_WRITE',1 )
CALL MPI_FILE_WRITE_AT_ALL(iunsparsetcb, lrepmatw3, sparsecb_t, lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',1)
!
! Offset for the next q iteration
lrepmatw5 = lrepmatw5 + INT(SUM(indcb(:)), kind = MPI_OFFSET_KIND) * 8_MPI_OFFSET_KIND
@ -605,9 +589,9 @@
etf_all(ibnd, ik+lower_bnd-1) = etf(ibndmin-1+ibnd, ikk)
ENDDO
ENDDO
CALL mp_sum ( vkk_all, world_comm )
CALL mp_sum ( etf_all, world_comm )
CALL mp_sum ( wkf_all, world_comm )
CALL MP_SUM(vkk_all, world_comm)
CALL MP_SUM(etf_all, world_comm)
CALL MP_SUM(wkf_all, world_comm)
!
IF ( my_pool_id == 0 ) THEN
@ -648,7 +632,7 @@
ENDIF
ENDDO
ENDDO
CALL mp_sum( carrier_density, world_comm )
CALL MP_SUM(carrier_density, world_comm)
carrier_density = carrier_density * inv_cell * ( bohr2ang * ang2cm)**(-3)
WRITE(stdout,'(5x, 1f8.3, 1f12.4, 1E19.6)') etemp *ryd2ev/kelvin2eV, &
ef0(itemp)*ryd2ev, carrier_density
@ -665,7 +649,7 @@
ENDIF
ENDDO
ENDDO
CALL mp_sum( carrier_density, world_comm )
CALL MP_SUM(carrier_density, world_comm)
carrier_density = carrier_density * inv_cell * ( bohr2ang * ang2cm)**(-3)
WRITE(stdout,'(5x, 1f8.3, 1f12.4, 1E19.6)') etemp *ryd2ev/kelvin2eV, &
efcb(itemp)*ryd2ev, carrier_density

30
EPW/src/wan2bloch.f90
View File

@ -1271,10 +1271,12 @@
! or noncollective (=non blocking) if using MPI_FILE_SEEK & MPI_FILE_READ.
! Here we want non blocking because not all the process have the same nb of ir.
!
CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_READ(iunepmatwp2, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_READ_ALL',1 )
!CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
!IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
!CALL MPI_FILE_READ(iunepmatwp2, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE,ierr)
!IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_READ_ALL',1 )
CALL MPI_FILE_READ_AT_ALL(iunepmatwp2, lrepmatw, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('ephwan2blochp', 'error in MPI_FILE_READ_AT_ALL',1)
!
DO iw2=1, dims
DO iw=1, dims
@ -1325,10 +1327,12 @@
! or noncollective (=non blocking) if using MPI_FILE_SEEK & MPI_FILE_READ.
! Here we want non blocking because not all the process have the same nb of ir.
!
CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_READ(iunepmatwp2, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_READ_ALL',1 )
!CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
!IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
!CALL MPI_FILE_READ(iunepmatwp2, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE,ierr)
!IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_READ_ALL',1 )
CALL MPI_FILE_READ_AT_ALL(iunepmatwp2, lrepmatw, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('ephwan2blochp', 'error in MPI_FILE_READ_AT_ALL',1)
!
CALL ZAXPY(nbnd * nbnd * nrr_k, cfac(1,ir,1,1), epmatw(:,:,:,1), 1, &
eptmp(:,:,:,imode), 1)
@ -1734,10 +1738,12 @@
! or noncollective (=non blocking) if using MPI_FILE_SEEK & MPI_FILE_READ.
! Here we want non blocking because not all the process have the same nb of ir.
!
CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
CALL MPI_FILE_READ(iunepmatwp2, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE,ierr)
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_READ_ALL',1 )
!CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
!IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
!CALL MPI_FILE_READ(iunepmatwp2, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE,ierr)
!IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_READ_ALL',1 )
CALL MPI_FILE_READ_AT_ALL(iunepmatwp2, lrepmatw, epmatw, lrepmatw2, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr)
IF (ierr /= 0) CALL errore('ephwan2blochp_mem', 'error in MPI_FILE_READ_AT_ALL',1)
#endif
!
!write(stdout,*)'ir epmatw ',use_ws, ir, sum(epmatw)