Again cleanup of parallel variables and pwcom/phcom references.

C.S.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@1355 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
sbraccia 2004-09-28 08:50:35 +00:00
parent e388a62e9e
commit 92558d111b
3 changed files with 207 additions and 184 deletions

View File

@ -1,43 +1,63 @@
!---------------------------------------
subroutine close_phq(flag)
!----------=========--------------------
!
USE io_files, ONLY: iunigk
use control_flags, ONLY : twfcollect
use phcom
use us, only : okvan
#ifdef __PARA
use para
#endif
implicit none
logical :: flag
logical :: exst
if ( twfcollect ) then
close (unit = iuwfc, status = 'delete')
else
close (unit = iuwfc, status = 'keep')
end if
close (unit = iudwf, status = 'keep')
close (unit = iubar, status = 'keep')
if(okvan) close(unit = iudrhous, status = 'keep')
if(epsil.or.zue) close (unit = iuebar, status = 'keep')
#ifdef __PARA
if (me.ne.1) goto 100
#endif
if (fildrho.ne.' ') close (unit = iudrho, status = 'keep')
#ifdef __PARA
100 continue
#endif
if (flag) then
call seqopn (iunrec, 'recover','unformatted',exst)
close (unit=iunrec,status='delete')
end if
close (unit = iunigk, status = 'delete')
return
end subroutine close_phq
! Copyright (C) 2001-2004 PWSCF 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 close_phq( flag )
!----------------------------------------------------------------------------
!
! ... Close all files.
! ... Called at the end of the run with flag=.TRUE. (removes 'recover')
! ... or during execution with flag=.FALSE. (does not remove 'recover')
!
USE io_files, ONLY : iunigk
USE control_flags, ONLY : twfcollect
USE mp_global, ONLY : me_pool
USE us, ONLY : okvan
USE units_ph, ONLY : iuwfc, iudwf, iubar, iudrhous, iuebar, iudrho, &
iunrec, iunigk
USE control_ph, ONLY : zue, epsil
USE output, ONLY : fildrho
!
IMPLICIT NONE
!
LOGICAL :: flag
LOGICAL :: exst
!
!
IF ( twfcollect ) THEN
!
CLOSE( UNIT = iuwfc, STATUS = 'DELETE' )
!
ELSE
!
CLOSE( UNIT = iuwfc, STATUS = 'KEEP' )
!
END IF
!
CLOSE( UNIT = iudwf, STATUS = 'KEEP' )
CLOSE( UNIT = iubar, STATUS = 'KEEP' )
!
IF ( okvan ) CLOSE( UNIT = iudrhous, STATUS = 'KEEP' )
!
IF ( epsil .OR. zue ) CLOSE( UNIT = iuebar, STATUS = 'KEEP' )
!
IF ( me_pool == 0 .AND. &
fildrho /= ' ') CLOSE( UNIT = iudrho, STATUS = 'KEEP' )
!
IF ( flag ) THEN
!
CALL seqopn( iunrec, 'recover', 'UNFORMATTED', exst )
!
CLOSE( UNIT = iunrec, STATUS = 'DELETE' )
!
END IF
!
CLOSE( UNIT = iunigk, STATUS = 'DELETE' )
!
RETURN
!
END SUBROUTINE close_phq

View File

@ -1,40 +1,48 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2001-2004 PWSCF 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 openfilq
!-----------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE openfilq()
!----------------------------------------------------------------------------
!
! This subroutine opens all the files necessary for the phononq
! calculation.
! ... This subroutine opens all the files necessary for the phononq
! ... calculation.
!
use pwcom
use mp, only: mp_end
use io_files, only: prefix, iunigk
USE kinds, only : DP
use phcom
use control_flags, ONLY : twfcollect
#ifdef __PARA
use para
#endif
use restart_module, only: readfile_new
implicit none
integer :: ios
USE kinds, ONLY : DP
USE units_ph, ONLY : iuwfc, iudwf, iubar, iucom, iudvkb3, &
iudrhous, iuebar, iudrho, iudyn, iudvscf, &
lrwfc, lrdwf, lrbar, lrcom, lrdvkb3, &
lrdrhous, lrebar, lrdrho
USE control_ph, ONLY : epsil, zue, recover, trans, elph
USE output, ONLY : fildrho, fildyn, fildvscf
USE us, ONLY : okvan
USE wvfct, ONLY : nbnd, npwx
USE gvect, ONLY : nrx1, nrx2, nrx3, nrxx
USE lsda_mod, ONLY : nspin
USE uspp, ONLY : nkb
USE io_files, ONLY : prefix, iunigk
USE control_flags, ONLY : twfcollect
USE restart_module, ONLY : readfile_new
USE mp_global, ONLY : me_pool, kunit
USE io_global, ONLY : ionode
!
IMPLICIT NONE
!
INTEGER :: ios
! integer variable for I/O control
character (len=256) :: filint
CHARACTER (len=256) :: filint
! the name of the file
logical :: exst
LOGICAL :: exst
! logical variable to check file existe
!
real(kind=DP) :: edum(1,1), wdum(1,1)
integer :: ndr, ierr, kunittmp
REAL(kind=DP) :: edum(1,1), wdum(1,1)
INTEGER :: ndr, ierr, kunittmp
if (len_trim(prefix) == 0) call errore ('openfilq', 'wrong prefix', 1)
IF (LEN_TRIM(prefix) == 0) CALL errore ('openfilq', 'wrong prefix', 1)
!
! There are six direct access files to be opened in the tmp area
@ -44,132 +52,134 @@ subroutine openfilq
iuwfc = 20
lrwfc = 2 * nbnd * npwx
filint = trim(prefix)//'.wfc'
call diropn (iuwfc, filint, lrwfc, exst)
filint = TRIM(prefix)//'.wfc'
CALL diropn (iuwfc, filint, lrwfc, exst)
if (.not.exst) then
IF (.NOT.exst) THEN
ndr = 4
kunittmp = 1
# ifdef __PARA
kunittmp = kunit
# endif
call readfile_new( 'wave', ndr, edum, wdum, kunittmp, lrwfc, iuwfc, ierr )
if( ierr > 0 ) &
call errore ('openfilq', 'file '//filint//' not found', 1)
twfcollect=.not.exst
end if
CALL readfile_new( 'wave', ndr, edum, wdum, kunittmp, lrwfc, iuwfc, ierr )
IF( ierr > 0 ) &
CALL errore ('openfilq', 'file '//filint//' not found', 1)
twfcollect=.NOT.exst
END IF
!
! The file with deltaV_{bare} * psi
!
iubar = 21
lrbar = 2 * nbnd * npwx
filint = trim(prefix) //'.bar'
call diropn (iubar, filint, lrbar, exst)
if (recover.and..not.exst) call errore ('openfilq','file bar not found', 1)
filint = TRIM(prefix) //'.bar'
CALL diropn (iubar, filint, lrbar, exst)
IF (recover.AND..NOT.exst) CALL errore ('openfilq','file bar not found', 1)
!
! The file with the solution delta psi
!
iudwf = 22
lrdwf = 2 * nbnd * npwx
filint = trim(prefix) //'.dwf'
call diropn (iudwf, filint, lrdwf, exst)
if (recover.and..not.exst) call errore ('openfilq','file dwf not found', 1)
filint = TRIM(prefix) //'.dwf'
CALL diropn (iudwf, filint, lrdwf, exst)
IF (recover.AND..NOT.exst) CALL errore ('openfilq','file dwf not found', 1)
!
! open a file with the static change of the charge
!
if (okvan) then
IF (okvan) THEN
iudrhous = 25
lrdrhous = 2 * nrxx * nspin
filint = trim(prefix) //'.prd'
call diropn (iudrhous, filint, lrdrhous, exst)
if (recover.and..not.exst) call errore ('openfilq','file prod not found', 1)
endif
filint = TRIM(prefix) //'.prd'
CALL diropn (iudrhous, filint, lrdrhous, exst)
IF (recover.AND..NOT.exst) CALL errore ('openfilq','file prod not found', 1)
ENDIF
!
! An optional file for testing purposes containing the deltarho
!
if (fildrho.ne.' ') then
IF (fildrho.NE.' ') THEN
iudrho = 23
lrdrho = 2 * nrx1 * nrx2 * nrx3 * nspin
#ifdef __PARA
if (me.ne.1) goto 300
#endif
if(epsil) then
filint = trim(fildrho)//".E"
else
filint = trim(fildrho)//".u"
end if
call diropn (iudrho, filint, lrdrho, exst)
#ifdef __PARA
300 continue
#endif
endif
IF ( me_pool == 0 ) THEN
!
IF(epsil) THEN
filint = TRIM(fildrho)//".E"
ELSE
filint = TRIM(fildrho)//".u"
END IF
!
CALL diropn (iudrho, filint, lrdrho, exst)
!
END IF
ENDIF
!
! Here the sequential files
!
! The igk at a given k (and k+q if q!=0)
!
iunigk = 24
filint = trim(prefix) //'.igk'
call seqopn (iunigk, filint, 'unformatted', exst)
filint = TRIM(prefix) //'.igk'
CALL seqopn (iunigk, filint, 'unformatted', exst)
!
! a formatted file which contains the dynamical matrix in cartesian
! coordinates is opened in the current directory
#ifdef __PARA
! ... by the first node only, other nodes write on unit 6 (i.e./dev/nu
! exception: electron-phonon calculation from saved data
! (iudyn is read, not written, by all nodes)
!
if ( (me.ne.1.or.mypool.ne.1) .and. (.not.elph.or.trans) ) then
IF ( ( .NOT. ionode ) .AND. (.NOT.elph.OR.trans) ) THEN
iudyn = 6
goto 400
endif
#endif
if (trans.or.elph) then
GOTO 400
ENDIF
IF (trans.OR.elph) THEN
iudyn = 26
open (unit = iudyn, file = fildyn, status = 'unknown', err = &
OPEN (unit = iudyn, file = fildyn, status = 'unknown', err = &
100, iostat = ios)
100 call errore ('openfilq', 'opening file'//fildyn, abs (ios) )
rewind (iudyn)
endif
100 CALL errore ('openfilq', 'opening file'//fildyn, ABS (ios) )
REWIND (iudyn)
ENDIF
!
! An optional file for electron-phonon calculations containing deltaVs
!
400 if (fildvscf.ne.' ') then
400 IF (fildvscf.NE.' ') THEN
iudvscf = 27
call seqopn (iudvscf, fildvscf, 'unformatted', exst)
rewind (iudvscf)
end if
CALL seqopn (iudvscf, fildvscf, 'unformatted', exst)
REWIND (iudvscf)
END IF
!
! In the USPP case we need two files for the Commutator, the first is
! given by filbar and a second which just contains P_c x |psi>,
! which is required for the calculation of the Born effective carges
!
if (okvan .and. (epsil .or. zue)) then
IF (okvan .AND. (epsil .OR. zue)) THEN
iucom = 28
lrcom = 2 * nbnd * npwx
filint = trim(prefix) //'.com'
call diropn (iucom, filint, lrcom, exst)
if (recover.and..not.exst) &
call errore ('openfilq', 'file com not found', 1)
filint = TRIM(prefix) //'.com'
CALL diropn (iucom, filint, lrcom, exst)
IF (recover.AND..NOT.exst) &
CALL errore ('openfilq', 'file com not found', 1)
!
! In the USPP case we also need a file in order to store derivatives
! ok kb projectors
!
iudvkb3 = 29
lrdvkb3 = 2 * npwx * nkb * 3
filint = trim(prefix) //'.dvkb3'
call diropn (iudvkb3, filint, lrdvkb3, exst)
if (recover.and..not.exst) &
call errore ('openfilq', 'file dvkb3 not found', 1)
endif
if (epsil .or. zue) then
filint = TRIM(prefix) //'.dvkb3'
CALL diropn (iudvkb3, filint, lrdvkb3, exst)
IF (recover.AND..NOT.exst) &
CALL errore ('openfilq', 'file dvkb3 not found', 1)
ENDIF
IF (epsil .OR. zue) THEN
iuebar = 30
lrebar = 2 * nbnd * npwx
filint = trim(prefix) //'.ebar'
call diropn (iuebar, filint, lrebar, exst)
if (recover.and..not.exst) &
call errore ('openfilq','file ebar not found', 1)
endif
return
end subroutine openfilq
filint = TRIM(prefix) //'.ebar'
CALL diropn (iuebar, filint, lrebar, exst)
IF (recover.AND..NOT.exst) &
CALL errore ('openfilq','file ebar not found', 1)
ENDIF
!
RETURN
!
END SUBROUTINE openfilq

View File

@ -1,60 +1,53 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2001-2004 PWSCF 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 stop_ph (flag)
!-----------------------------------------------------------------------
!----------------------------------------------------------------------------
SUBROUTINE stop_ph( flag )
!----------------------------------------------------------------------------
!
! Close all files and synchronize processes before stopping.
! Called at the end of the run with flag=.true. (removes 'recover')
! or during execution with flag=.false. (does not remove 'recover')
! ... Synchronize processes before stopping.
!
USE kinds, ONLY : DP
USE mp, ONLY : mp_end, mp_barrier
!
use pwcom
USE kinds, only : DP
use phcom
! use control_flags, ONLY : twfcollect
use mp, only: mp_end, mp_barrier
USE parallel_include
#ifdef __PARA
use para
#endif
implicit none
#ifdef __PARA
integer :: info
#endif
logical :: flag, exst
call print_clock_ph
call show_memory ()
#ifdef __PARA
call mp_barrier()
! call mpi_finalize (info)
#endif
call mp_end()
#ifdef __T3E
!
! set streambuffers off
IMPLICIT NONE
!
INTEGER :: info
LOGICAL :: flag, exst
!
!
CALL print_clock_ph()
!
CALL show_memory()
!
CALL mp_barrier()
!
CALL mp_end()
!
#if defined (__T3E)
!
! ... set streambuffers off
!
CALL set_d_stream( 0 )
!
call set_d_stream (0)
#endif
call deallocate_part
if (flag) then
stop
else
stop 1
endif
end subroutine stop_ph
!
CALL deallocate_part()
!
IF ( flag ) THEN
!
STOP
!
ELSE
!
STOP 1
!
ENDIF
!
END SUBROUTINE stop_ph