mirror of https://gitlab.com/QEF/q-e.git
195 lines
5.8 KiB
Fortran
195 lines
5.8 KiB
Fortran
!
|
|
! Copyright (C) 2011-2020 Quantum ESPRESSO 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 .
|
|
!
|
|
! Aug 2020 (PG): streamlined and simplified
|
|
! open_input_file() may read the file name either from
|
|
! passed argumet or directly from the command line
|
|
! Aug 2018 (PG): reading of old xml input file using iotk deleted
|
|
|
|
MODULE open_close_input_file
|
|
!
|
|
!! Input file management.
|
|
!
|
|
USE io_global, ONLY : stdin, stdout, qestdin
|
|
!
|
|
CHARACTER(LEN=256), SAVE :: input_file = ' '
|
|
PRIVATE
|
|
PUBLIC :: get_file_name, open_input_file, close_input_file
|
|
!
|
|
CONTAINS
|
|
!----------------------------------------------------------------------------
|
|
FUNCTION get_file_name ( )
|
|
!
|
|
!! Get the file name provided in command line
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
CHARACTER (len=256) :: get_file_name
|
|
!
|
|
LOGICAL :: found
|
|
INTEGER :: iiarg, nargs
|
|
!
|
|
nargs = command_argument_count()
|
|
get_file_name = ' '
|
|
found = .false.
|
|
!
|
|
DO iiarg = 1, ( nargs - 1 )
|
|
!
|
|
CALL get_command_argument( iiarg, get_file_name )
|
|
!
|
|
IF ( TRIM( get_file_name ) == '-i' .OR. &
|
|
TRIM( get_file_name ) == '-in' .OR. &
|
|
TRIM( get_file_name ) == '-inp' .OR. &
|
|
TRIM( get_file_name ) == '-input' ) THEN
|
|
!
|
|
CALL get_command_argument( ( iiarg + 1 ) , get_file_name )
|
|
found = .true.
|
|
EXIT
|
|
!
|
|
END IF
|
|
!
|
|
END DO
|
|
!
|
|
IF ( .NOT. found ) get_file_name = ' '
|
|
!
|
|
END FUNCTION get_file_name
|
|
!
|
|
!----------------------------------------------------------------------------
|
|
FUNCTION open_input_file ( input_file_, is_xml) RESULT ( ierr )
|
|
!-----------------------------------------------------------------------------
|
|
!! Open file for input read, connecting it to unit \(\text{qestdin}\).
|
|
!! If optional variable \(\text{is_xml}\) is present, test if the file is a
|
|
!! valid xml file.
|
|
!! In parallel execution, must be called by a single processor.
|
|
!! Module varliable input_file is set to the file name actually read.
|
|
!---------------------------------------------------------------
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
CHARACTER (len=*), intent(in), OPTIONAL :: input_file_
|
|
!! If \(\text{input_file_}\) is not present, read it from command line.
|
|
!! If \(\text{input_file_}\) is empty, the standard input is dumped to
|
|
!! temporary file "input_tmp.in" and this is opened for read
|
|
LOGICAL, intent(out), OPTIONAL :: is_xml
|
|
!! \(\text{is_xml}=\text{TRUE}\) if the file has extension '.xml' or '.XML'
|
|
!! or if either <xml...> or <?xml...> is found as first token.
|
|
INTEGER :: ierr
|
|
!! On exit:
|
|
!! \(\text{ierr} = -1\) if standard input is successfuly dumped to file;
|
|
!! \(\text{ierr} = 0\) if input file is successfully opened;
|
|
!! \(\text{ierr} = 1\) if there was an error opening file.
|
|
!
|
|
LOGICAL :: is_xml_, is_tmp
|
|
INTEGER :: length
|
|
CHARACTER(LEN=512) :: dummy
|
|
LOGICAL, EXTERNAL :: test_input_xml
|
|
!
|
|
! copy file to be opened into input_file
|
|
!
|
|
IF ( PRESENT(input_file_) ) THEN
|
|
input_file = input_file_
|
|
ELSE
|
|
input_file = get_file_name ( )
|
|
END IF
|
|
!
|
|
! is_tmp: no file name read or provided, dump to "input_tmp.in"
|
|
!
|
|
is_tmp = ( TRIM(input_file) == ' ' )
|
|
IF ( is_tmp ) THEN
|
|
!
|
|
input_file="input_tmp.in"
|
|
OPEN(UNIT = qestdin, FILE=input_file, FORM='formatted', &
|
|
STATUS='unknown', IOSTAT = ierr )
|
|
IF ( ierr > 0 ) GO TO 30
|
|
!
|
|
dummy=' '
|
|
WRITE(stdout, '(5x,a)') "Waiting for input..."
|
|
DO
|
|
READ (stdin,fmt='(A512)',END=20, ERR=30) dummy
|
|
WRITE (qestdin,'(A)') trim(dummy)
|
|
END DO
|
|
!
|
|
20 CLOSE ( UNIT=qestdin, STATUS='keep' )
|
|
!
|
|
ENDIF
|
|
!
|
|
is_xml_ = PRESENT(is_xml)
|
|
IF (is_xml_) THEN
|
|
!
|
|
length = LEN_TRIM(input_file)
|
|
IF ( length > 4 ) THEN
|
|
is_xml = ( input_file(length-3:length) == '.xml' .OR. &
|
|
input_file(length-3:length) == '.XML' )
|
|
ELSE
|
|
is_xml = .false.
|
|
END IF
|
|
IF ( .NOT. is_xml ) THEN
|
|
OPEN ( UNIT = qestdin, FILE = input_file , FORM = 'FORMATTED', &
|
|
STATUS = 'OLD', IOSTAT = ierr )
|
|
IF ( ierr > 0 ) GO TO 30
|
|
is_xml = test_input_xml (qestdin )
|
|
CLOSE ( UNIT=qestdin, status='keep')
|
|
END IF
|
|
is_xml_ = is_xml
|
|
!
|
|
ENDIF
|
|
!
|
|
IF ( is_xml_ ) then
|
|
IF ( is_tmp ) THEN
|
|
WRITE(stdout, '(5x,a)') "Reading xml input from standard input"
|
|
ELSE
|
|
WRITE(stdout, '(5x,a)') "Reading xml input from "//TRIM(input_file)
|
|
END IF
|
|
ELSE
|
|
IF ( is_tmp ) THEN
|
|
WRITE(stdout, '(5x,a)') "Reading input from standard input"
|
|
ELSE
|
|
WRITE(stdout, '(5x,a)') "Reading input from "//TRIM(input_file)
|
|
END IF
|
|
ENDIF
|
|
!
|
|
OPEN ( UNIT = qestdin, FILE = input_file, FORM = 'FORMATTED', &
|
|
STATUS = 'OLD', IOSTAT = ierr )
|
|
!
|
|
IF ( ierr > 0 ) GO TO 30
|
|
IF ( is_tmp ) ierr = -1
|
|
RETURN
|
|
!
|
|
30 ierr = 1
|
|
!
|
|
! Do not call "errore" here: may hang in parallel execution
|
|
!
|
|
WRITE(stdout, "('open_input_file: fatal error opening ',A)") TRIM(input_file)
|
|
!
|
|
END FUNCTION open_input_file
|
|
|
|
FUNCTION close_input_file ( ) RESULT ( ierr )
|
|
!
|
|
!! This subroutine closes the input file opened by \(\texttt{open_input_file}\),
|
|
!! also removes temporary file if data was dumped from \(\text{stdin}\) and
|
|
!! returns -1 if unit is not opened, 0 if no problem, > 0 if problems.
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
INTEGER :: ierr
|
|
LOGICAL :: opnd
|
|
!
|
|
INQUIRE ( qestdin, opened = opnd )
|
|
IF (opnd) THEN
|
|
IF ( TRIM(input_file) == "input_tmp.in") THEN
|
|
CLOSE (UNIT=qestdin, STATUS='delete', IOSTAT=ierr )
|
|
ELSE
|
|
CLOSE (UNIT=qestdin, STATUS='keep', IOSTAT=ierr )
|
|
ENDIF
|
|
ELSE
|
|
ierr = -1
|
|
ENDIF
|
|
!
|
|
END FUNCTION close_input_file
|
|
!
|
|
END MODULE open_close_input_file
|