mirror of https://gitlab.com/QEF/q-e.git
Remove allocate
This commit is contained in:
parent
edac3d551d
commit
94ed130b4f
|
@ -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
|
|
|
@ -1,4 +1,4 @@
|
||||||
!iufilibtev_sup
|
!
|
||||||
! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino
|
! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino
|
||||||
!
|
!
|
||||||
! This file is distributed under the terms of the GNU General Public
|
! This file is distributed under the terms of the GNU General Public
|
||||||
|
|
|
@ -472,51 +472,47 @@
|
||||||
! WRITE(stdout,'(a,i9,E22.8)') ' Total number of element written ',ind_tot
|
! WRITE(stdout,'(a,i9,E22.8)') ' Total number of element written ',ind_tot
|
||||||
!
|
!
|
||||||
! Size of what we write
|
! Size of what we write
|
||||||
lsize = INT( ind(my_pool_id+1), kind = MPI_OFFSET_KIND )
|
lsize = INT(ind(my_pool_id + 1), kind = MPI_OFFSET_KIND)
|
||||||
|
|
||||||
! Offset where we need to start writing (we increment for each q-points)
|
! Offset where we need to start writing (we increment for each q-points)
|
||||||
lrepmatw = lrepmatw2 + &
|
lrepmatw = lrepmatw2 + &
|
||||||
INT( SUM( ind(1:my_pool_id+1)) - ind(my_pool_id+1), kind = MPI_OFFSET_KIND ) * 8_MPI_OFFSET_KIND
|
INT(SUM(ind(1:my_pool_id + 1)) - ind(my_pool_id + 1), kind = MPI_OFFSET_KIND) * 8_MPI_OFFSET_KIND
|
||||||
lrepmatw3 = lrepmatw4 + &
|
lrepmatw3 = lrepmatw4 + &
|
||||||
INT( SUM( ind(1:my_pool_id+1)) - ind(my_pool_id+1), kind = MPI_OFFSET_KIND ) * 4_MPI_OFFSET_KIND
|
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)
|
!CALL MPI_FILE_SEEK(iunepmat, lrepmatw,MPI_SEEK_SET,ierr)
|
||||||
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
|
!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)
|
!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 )
|
!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)
|
!CALL MPI_FILE_SEEK (iunsparseq, lrepmatw3,MPI_SEEK_SET,ierr)
|
||||||
IF( ierr /= 0 ) CALL errore( 'print_ibte', 'error in MPI_FILE_SEEK',1 )
|
!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)
|
!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 )
|
!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)
|
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_SEEK',1 )
|
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',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_SEEK (iunsparsei, lrepmatw3,MPI_SEEK_SET,ierr)
|
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_SEEK',1 )
|
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',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_SEEK (iunsparsej, lrepmatw3,MPI_SEEK_SET,ierr)
|
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_SEEK',1 )
|
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',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_SEEK (iunsparset, lrepmatw3,MPI_SEEK_SET,ierr)
|
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_SEEK',1 )
|
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',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 )
|
|
||||||
!
|
!
|
||||||
! Offset for the next q iteration
|
! Offset for the next q iteration
|
||||||
lrepmatw2 = lrepmatw2 + INT( SUM( ind(:) ), kind = MPI_OFFSET_KIND ) * 8_MPI_OFFSET_KIND
|
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
|
lrepmatw4 = lrepmatw4 + INT(SUM(ind(:)), kind = MPI_OFFSET_KIND ) * 4_MPI_OFFSET_KIND
|
||||||
!
|
!
|
||||||
! now write in the support file
|
! now write in the support file
|
||||||
CALL mp_sum(xkf_all, world_comm)
|
CALL MP_SUM(xkf_all, world_comm)
|
||||||
CALL mp_sum(wkf_all, world_comm)
|
CALL MP_SUM(wkf_all, world_comm)
|
||||||
!
|
!
|
||||||
ENDIF
|
ENDIF
|
||||||
IF ( sum(indcb) > 0 ) THEN
|
IF ( sum(indcb) > 0 ) THEN
|
||||||
|
@ -527,47 +523,35 @@
|
||||||
! WRITE(stdout,'(a,i9,E22.8)') ' Total number of element written in electron ',ind_totcb
|
! WRITE(stdout,'(a,i9,E22.8)') ' Total number of element written in electron ',ind_totcb
|
||||||
!
|
!
|
||||||
! Size of what we write
|
! Size of what we write
|
||||||
lsize = INT( indcb(my_pool_id+1), kind = MPI_OFFSET_KIND )
|
lsize = INT(indcb(my_pool_id + 1), kind = MPI_OFFSET_KIND)
|
||||||
|
|
||||||
! Offset where we need to start writing (we increment for each q-points)
|
! Offset where we need to start writing (we increment for each q-points)
|
||||||
lrepmatw = lrepmatw5 + &
|
lrepmatw = lrepmatw5 + &
|
||||||
INT( SUM( indcb(1:my_pool_id+1)) - indcb(my_pool_id+1), kind = MPI_OFFSET_KIND ) * 8_MPI_OFFSET_KIND
|
INT(SUM(indcb(1:my_pool_id + 1)) - indcb(my_pool_id + 1), kind = MPI_OFFSET_KIND) * 8_MPI_OFFSET_KIND
|
||||||
lrepmatw3 = lrepmatw6 + &
|
lrepmatw3 = lrepmatw6 + &
|
||||||
INT( SUM( indcb(1:my_pool_id+1)) - indcb(my_pool_id+1), kind = MPI_OFFSET_KIND ) * 4_MPI_OFFSET_KIND
|
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)
|
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_SEEK',1 )
|
IF (ierr /= 0) CALL errore('print_ibte', 'error in MPI_FILE_WRITE_AT_ALL',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_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_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_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_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_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(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_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_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_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_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
|
! Offset for the next q iteration
|
||||||
lrepmatw5 = lrepmatw5 + INT( SUM( indcb(:) ), kind = MPI_OFFSET_KIND ) * 8_MPI_OFFSET_KIND
|
lrepmatw5 = lrepmatw5 + INT(SUM(indcb(:)), kind = MPI_OFFSET_KIND) * 8_MPI_OFFSET_KIND
|
||||||
lrepmatw6 = lrepmatw6 + INT( SUM( indcb(:) ), kind = MPI_OFFSET_KIND ) * 4_MPI_OFFSET_KIND
|
lrepmatw6 = lrepmatw6 + INT(SUM(indcb(:)), kind = MPI_OFFSET_KIND) * 4_MPI_OFFSET_KIND
|
||||||
!
|
!
|
||||||
ENDIF ! indcb
|
ENDIF ! indcb
|
||||||
#endif
|
#endif
|
||||||
|
@ -605,9 +589,9 @@
|
||||||
etf_all(ibnd, ik+lower_bnd-1) = etf(ibndmin-1+ibnd, ikk)
|
etf_all(ibnd, ik+lower_bnd-1) = etf(ibndmin-1+ibnd, ikk)
|
||||||
ENDDO
|
ENDDO
|
||||||
ENDDO
|
ENDDO
|
||||||
CALL mp_sum ( vkk_all, world_comm )
|
CALL MP_SUM(vkk_all, world_comm)
|
||||||
CALL mp_sum ( etf_all, world_comm )
|
CALL MP_SUM(etf_all, world_comm)
|
||||||
CALL mp_sum ( wkf_all, world_comm )
|
CALL MP_SUM(wkf_all, world_comm)
|
||||||
!
|
!
|
||||||
IF ( my_pool_id == 0 ) THEN
|
IF ( my_pool_id == 0 ) THEN
|
||||||
|
|
||||||
|
@ -621,9 +605,9 @@
|
||||||
WRITE(iufilibtev_sup,'(i8,2E22.12)') itemp, ef0(itemp), efcb(itemp)
|
WRITE(iufilibtev_sup,'(i8,2E22.12)') itemp, ef0(itemp), efcb(itemp)
|
||||||
ENDDO
|
ENDDO
|
||||||
WRITE(iufilibtev_sup,'(a)') '# ik ibnd velocity (x,y,z) eig weight '
|
WRITE(iufilibtev_sup,'(a)') '# ik ibnd velocity (x,y,z) eig weight '
|
||||||
DO ik = 1, nkqtotf/2
|
DO ik=1, nkqtotf / 2
|
||||||
DO ibnd = 1, ibndmax-ibndmin+1
|
DO ibnd=1, ibndmax - ibndmin + 1
|
||||||
WRITE(iufilibtev_sup,'(i8,i6,5E22.12)') ik, ibnd, vkk_all(:,ibnd,ik), etf_all(ibnd, ik), wkf_all(ik)
|
WRITE(iufilibtev_sup,'(i8,i6,5E22.12)') ik, ibnd, vkk_all(:, ibnd, ik), etf_all(ibnd, ik), wkf_all(ik)
|
||||||
ENDDO
|
ENDDO
|
||||||
ENDDO
|
ENDDO
|
||||||
CLOSE(iufilibtev_sup)
|
CLOSE(iufilibtev_sup)
|
||||||
|
@ -636,36 +620,36 @@
|
||||||
carrier_density = 0.0
|
carrier_density = 0.0
|
||||||
!
|
!
|
||||||
IF ( ncarrier < 0.0 ) THEN ! VB
|
IF ( ncarrier < 0.0 ) THEN ! VB
|
||||||
DO ik = 1, nkf
|
DO ik=1, nkf
|
||||||
DO ibnd = 1, ibndmax-ibndmin+1
|
DO ibnd=1, ibndmax - ibndmin + 1
|
||||||
! This selects only valence bands for hole conduction
|
! This selects only valence bands for hole conduction
|
||||||
IF (etf_all (ibnd, ik+lower_bnd-1 ) < ef0(itemp) ) THEN
|
IF (etf_all(ibnd, ik + lower_bnd - 1 ) < ef0(itemp)) THEN
|
||||||
! energy at k (relative to Ef)
|
! energy at k (relative to Ef)
|
||||||
ekk = etf_all (ibnd, ik+lower_bnd-1 ) - ef0(itemp)
|
ekk = etf_all (ibnd, ik+lower_bnd-1 ) - ef0(itemp)
|
||||||
fnk = wgauss( -ekk / etemp, -99)
|
fnk = wgauss( -ekk / etemp, -99)
|
||||||
! The wkf(ikk) already include a factor 2
|
! The wkf(ikk) already include a factor 2
|
||||||
carrier_density = carrier_density + wkf_all(ik+lower_bnd-1 ) * (1.0d0 - fnk )
|
carrier_density = carrier_density + wkf_all(ik + lower_bnd - 1) * (1.0d0 - fnk)
|
||||||
ENDIF
|
ENDIF
|
||||||
ENDDO
|
ENDDO
|
||||||
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)
|
carrier_density = carrier_density * inv_cell * ( bohr2ang * ang2cm)**(-3)
|
||||||
WRITE(stdout,'(5x, 1f8.3, 1f12.4, 1E19.6)') etemp *ryd2ev/kelvin2eV, &
|
WRITE(stdout,'(5x, 1f8.3, 1f12.4, 1E19.6)') etemp *ryd2ev/kelvin2eV, &
|
||||||
ef0(itemp)*ryd2ev, carrier_density
|
ef0(itemp)*ryd2ev, carrier_density
|
||||||
ELSE ! CB
|
ELSE ! CB
|
||||||
DO ik = 1, nkf
|
DO ik=1, nkf
|
||||||
DO ibnd = 1, ibndmax-ibndmin+1
|
DO ibnd=1, ibndmax - ibndmin + 1
|
||||||
! This selects only valence bands for hole conduction
|
! This selects only valence bands for hole conduction
|
||||||
IF (etf_all (ibnd, ik+lower_bnd-1 ) > efcb(itemp) ) THEN
|
IF (etf_all (ibnd, ik+lower_bnd-1 ) > efcb(itemp) ) THEN
|
||||||
! energy at k (relative to Ef)
|
! energy at k (relative to Ef)
|
||||||
ekk = etf_all (ibnd, ik+lower_bnd-1 ) - efcb(itemp)
|
ekk = etf_all(ibnd, ik+lower_bnd-1) - efcb(itemp)
|
||||||
fnk = wgauss( -ekk / etemp, -99)
|
fnk = wgauss( -ekk / etemp, -99)
|
||||||
! The wkf(ikk) already include a factor 2
|
! The wkf(ikk) already include a factor 2
|
||||||
carrier_density = carrier_density + wkf_all(ik+lower_bnd-1 ) * fnk
|
carrier_density = carrier_density + wkf_all(ik + lower_bnd - 1) * fnk
|
||||||
ENDIF
|
ENDIF
|
||||||
ENDDO
|
ENDDO
|
||||||
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)
|
carrier_density = carrier_density * inv_cell * ( bohr2ang * ang2cm)**(-3)
|
||||||
WRITE(stdout,'(5x, 1f8.3, 1f12.4, 1E19.6)') etemp *ryd2ev/kelvin2eV, &
|
WRITE(stdout,'(5x, 1f8.3, 1f12.4, 1E19.6)') etemp *ryd2ev/kelvin2eV, &
|
||||||
efcb(itemp)*ryd2ev, carrier_density
|
efcb(itemp)*ryd2ev, carrier_density
|
||||||
|
|
|
@ -1271,10 +1271,12 @@
|
||||||
! or noncollective (=non blocking) if using MPI_FILE_SEEK & MPI_FILE_READ.
|
! 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.
|
! 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)
|
!CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
|
||||||
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
|
!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)
|
!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 )
|
!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 iw2=1, dims
|
||||||
DO iw=1, dims
|
DO iw=1, dims
|
||||||
|
@ -1325,10 +1327,12 @@
|
||||||
! or noncollective (=non blocking) if using MPI_FILE_SEEK & MPI_FILE_READ.
|
! 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.
|
! 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)
|
!CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
|
||||||
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
|
!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)
|
!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 )
|
!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, &
|
CALL ZAXPY(nbnd * nbnd * nrr_k, cfac(1,ir,1,1), epmatw(:,:,:,1), 1, &
|
||||||
eptmp(:,:,:,imode), 1)
|
eptmp(:,:,:,imode), 1)
|
||||||
|
@ -1734,10 +1738,12 @@
|
||||||
! or noncollective (=non blocking) if using MPI_FILE_SEEK & MPI_FILE_READ.
|
! 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.
|
! 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)
|
!CALL MPI_FILE_SEEK(iunepmatwp2,lrepmatw,MPI_SEEK_SET,ierr)
|
||||||
IF( ierr /= 0 ) CALL errore( 'ephwan2blochp', 'error in MPI_FILE_SEEK',1 )
|
!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)
|
!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 )
|
!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
|
#endif
|
||||||
!
|
!
|
||||||
!write(stdout,*)'ir epmatw ',use_ws, ir, sum(epmatw)
|
!write(stdout,*)'ir epmatw ',use_ws, ir, sum(epmatw)
|
||||||
|
|
Loading…
Reference in New Issue