mirror of https://gitlab.com/QEF/q-e.git
191 lines
5.6 KiB
Fortran
191 lines
5.6 KiB
Fortran
!
|
|
! Copyright (C) 2011-2012 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 .
|
|
!
|
|
MODULE open_close_input_file
|
|
!
|
|
USE io_global, ONLY : stdout, xmlinputunit
|
|
! ... BEWARE: xmlinputunit modified by open_input_file
|
|
USE iotk_module, ONLY : iotk_open_read, iotk_close_read,iotk_attlenx
|
|
!
|
|
INTEGER, SAVE :: unit_loc = 5
|
|
LOGICAL, SAVE :: lxmlinput_loc = .false.
|
|
CHARACTER(LEN=256), SAVE :: input_file = ' '
|
|
PRIVATE
|
|
PUBLIC :: open_input_file, close_input_file
|
|
!
|
|
CONTAINS
|
|
!----------------------------------------------------------------------------
|
|
INTEGER FUNCTION open_input_file ( lxmlinput, attr, unit )
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
! ... opens "unit" (optional, unit_loc=5 if unspecified) for input read
|
|
! ... if lxmlinput=.true. and "attr" are present, tests for a xml file
|
|
! ... to be opened with attribute "attr"
|
|
! ... The code detects an input filename via options:
|
|
! ... "-in failename", "-inp filename", "-input filename"
|
|
! ... If no filename is not specified, the standard input is dumped to
|
|
! ... temporary file "input_tmp.in" and this is opened for read
|
|
! ... Returns -1 if standard input is dumped to file
|
|
! ... Returns 0 if input file is successfully opened
|
|
! ... Returns 1 if called with wrong arguments
|
|
! ... Returns 2 if there was an error opening file
|
|
! ... ---------------------------------------------------------------
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
INTEGER, EXTERNAL :: find_free_unit
|
|
!
|
|
LOGICAL, intent(inout), optional :: lxmlinput
|
|
CHARACTER (len=*), intent(inout), optional :: attr
|
|
INTEGER, intent(in), optional :: unit
|
|
!
|
|
LOGICAL :: lfound, lxmlinput_loc,lcheckxml
|
|
INTEGER :: iiarg, nargs, iargc, ierr
|
|
CHARACTER (len=50) :: arg
|
|
!
|
|
INTEGER :: stdin=5, stdtmp
|
|
CHARACTER(LEN=512) :: dummy
|
|
!
|
|
#if defined(__ABSOFT)
|
|
# define getarg getarg_
|
|
# define iargc iargc_
|
|
#endif
|
|
!
|
|
IF ( PRESENT(attr) .AND. .NOT.PRESENT(lxmlinput) .OR. &
|
|
.NOT.PRESENT(attr) .AND. PRESENT(lxmlinput) ) THEN
|
|
!
|
|
open_input_file = 1
|
|
RETURN
|
|
!
|
|
ENDIF
|
|
!
|
|
lcheckxml = .false.
|
|
IF ( PRESENT(attr) .AND. (PRESENT(lxmlinput)) ) lcheckxml = .true.
|
|
!
|
|
unit_loc = 5
|
|
IF(PRESENT(unit)) unit_loc = unit
|
|
!
|
|
xmlinputunit = unit_loc
|
|
lxmlinput_loc = .false.
|
|
!
|
|
! ... Input from file ?
|
|
!
|
|
input_file=' '
|
|
lfound=.false.
|
|
nargs = iargc()
|
|
!
|
|
DO iiarg = 1, ( nargs - 1 )
|
|
!
|
|
CALL getarg( iiarg, input_file )
|
|
!
|
|
IF ( TRIM( input_file ) == '-input' .OR. &
|
|
TRIM( input_file ) == '-inp' .OR. &
|
|
TRIM( input_file ) == '-in' ) THEN
|
|
!
|
|
CALL getarg( ( iiarg + 1 ) , input_file )
|
|
!
|
|
lfound=.true.
|
|
GO TO 10
|
|
END IF
|
|
!
|
|
END DO
|
|
!
|
|
10 stdtmp = find_free_unit()
|
|
!
|
|
IF ( .NOT. lfound ) THEN
|
|
!
|
|
! if no file specified then copy from standard input
|
|
!
|
|
input_file="input_tmp.in"
|
|
OPEN(UNIT = stdtmp, FILE=trim(input_file), FORM='formatted', &
|
|
STATUS='unknown', IOSTAT = ierr )
|
|
IF ( ierr > 0 ) GO TO 30
|
|
!
|
|
dummy=' '
|
|
WRITE(stdout, '(5x,a)') "Waiting for input..."
|
|
DO WHILE ( TRIM(dummy) .NE. "MAGICALME" )
|
|
READ (stdin,fmt='(A512)',END=20) dummy
|
|
WRITE (stdtmp,'(A)') trim(dummy)
|
|
END DO
|
|
!
|
|
20 CLOSE ( UNIT=stdtmp, STATUS='keep' )
|
|
ENDIF
|
|
!
|
|
IF (lcheckxml) THEN
|
|
!
|
|
OPEN ( UNIT = stdtmp, FILE = TRIM(input_file) , FORM = 'FORMATTED', &
|
|
STATUS = 'OLD', IOSTAT = ierr )
|
|
IF ( ierr > 0 ) GO TO 30
|
|
CALL test_input_xml (stdtmp, lxmlinput_loc )
|
|
CLOSE ( UNIT=stdtmp, status='keep')
|
|
!
|
|
lxmlinput = lxmlinput_loc
|
|
!
|
|
ENDIF
|
|
!
|
|
IF (lxmlinput_loc) then
|
|
IF ( input_file .NE. "input_tmp.in") THEN
|
|
WRITE(stdout, '(5x,a)') "Reading xml input from "//TRIM(input_file)
|
|
ELSE
|
|
WRITE(stdout, '(5x,a)') "Reading xml input from standard input"
|
|
END IF
|
|
CALL iotk_open_read( unit_loc, TRIM(input_file), attr = attr, &
|
|
qe_syntax = .true., ierr = ierr)
|
|
ELSE
|
|
IF ( input_file .NE. "input_tmp.in") THEN
|
|
WRITE(stdout, '(5x,a)') "Reading input from "//TRIM(input_file)
|
|
ELSE
|
|
WRITE(stdout, '(5x,a)') "Reading input from standard input"
|
|
END IF
|
|
OPEN ( UNIT = unit_loc, FILE = TRIM(input_file), FORM = 'FORMATTED', &
|
|
STATUS = 'OLD', IOSTAT = ierr )
|
|
ENDIF
|
|
IF ( ierr > 0 ) GO TO 30
|
|
!
|
|
open_input_file = 0
|
|
RETURN
|
|
30 open_input_file = 2
|
|
RETURN
|
|
!
|
|
END FUNCTION open_input_file
|
|
|
|
INTEGER FUNCTION close_input_file ( )
|
|
!
|
|
! ... this subroutine closes the input file opened by open_input_file
|
|
! ... removes temporary file if data was read from stdin
|
|
! ... (not in the xml case, though, because it is not clear how to do it)
|
|
! ... returns -1 if unit is not opened, 0 if no problem, > 0 if problems
|
|
! ... ---------------------------------------------------------------
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
LOGICAL :: opened
|
|
INTEGER :: ierr
|
|
!
|
|
INQUIRE ( unit_loc, opened = opened )
|
|
IF (opened) THEN
|
|
!
|
|
IF (lxmlinput_loc) THEN
|
|
CALL iotk_close_read(unit=unit_loc, ierr = ierr)
|
|
ELSE
|
|
IF ( TRIM(input_file) == "input_tmp.in") THEN
|
|
CLOSE (UNIT=unit_loc, STATUS='delete', IOSTAT=ierr )
|
|
ELSE
|
|
CLOSE (UNIT=unit_loc, STATUS='keep', IOSTAT=ierr )
|
|
ENDIF
|
|
ENDIF
|
|
!
|
|
ELSE
|
|
ierr = -1
|
|
ENDIF
|
|
!
|
|
close_input_file = ierr
|
|
!
|
|
END FUNCTION close_input_file
|
|
!
|
|
ENDMODULE open_close_input_file
|