2003-01-20 05:58:50 +08:00
|
|
|
!
|
2005-08-23 23:50:05 +08:00
|
|
|
! Copyright (C) 2002-2005 Quantum-ESPRESSO group
|
2003-01-20 05:58:50 +08:00
|
|
|
! 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 .
|
|
|
|
|
!
|
2005-08-23 23:50:05 +08:00
|
|
|
!----------------------------------------------------------------------------
|
|
|
|
|
SUBROUTINE davcio( vect, nword, unit, nrec, io )
|
|
|
|
|
!----------------------------------------------------------------------------
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2005-08-23 23:50:05 +08:00
|
|
|
! ... direct-access vector input/output
|
|
|
|
|
! ... read/write nword words starting from the address specified by vect
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2003-11-04 18:53:05 +08:00
|
|
|
USE io_global, ONLY : stdout
|
2005-08-23 23:50:05 +08:00
|
|
|
USE kinds, ONLY : DP
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
INTEGER, INTENT(IN) :: nword, unit, nrec, io
|
|
|
|
|
! input: the dimension of vect
|
|
|
|
|
! input: the unit where to read/write
|
|
|
|
|
! input: the record where to read/write
|
|
|
|
|
! input: flag if < 0 reading if > 0 writing
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), INTENT(INOUT) :: vect(nword)
|
2005-08-23 23:50:05 +08:00
|
|
|
! input/output: the vector to read/write
|
|
|
|
|
!
|
|
|
|
|
INTEGER :: ios
|
|
|
|
|
! integer variable for I/O control
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
CALL start_clock( 'davcio' )
|
|
|
|
|
!
|
|
|
|
|
IF ( unit <= 0 ) CALL errore( 'davcio', 'wrong unit', 1 )
|
|
|
|
|
IF ( nrec <= 0 ) CALL errore( 'davcio', 'wrong record number', 2 )
|
|
|
|
|
IF ( nword <= 0 ) CALL errore( 'davcio', 'wrong record length', 3 )
|
2005-08-31 00:27:58 +08:00
|
|
|
IF ( io == 0 ) CALL infomsg('davcio', 'nothing to do?', -1 )
|
2005-08-23 23:50:05 +08:00
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
ios = 0
|
2005-08-23 23:50:05 +08:00
|
|
|
!
|
|
|
|
|
IF ( io < 0 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( UNIT = unit, REC = nrec, IOSTAT = ios ) vect
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( io > 0 ) THEN
|
|
|
|
|
!
|
|
|
|
|
WRITE( UNIT = unit, REC = nrec, IOSTAT = ios ) vect
|
|
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
IF ( ios /= 0 ) THEN
|
|
|
|
|
!
|
|
|
|
|
WRITE( stdout, '(1X,"IOS = ",I2)' ) ios
|
|
|
|
|
CALL errore( 'davcio', 'i/o error in davcio', unit )
|
|
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
CALL stop_clock( 'davcio' )
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
|
|
|
|
END SUBROUTINE davcio
|
