quantum-espresso/flib/inpfile.f90

87 lines
2.4 KiB
Fortran

!
! Copyright (C) 2002-2005 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 .
!
#include "f_defs.h"
!
!----------------------------------------------------------------------------
SUBROUTINE input_from_file( )
!
! This subroutine checks program arguments and, if input file is present,
! attach input unit ( 5 ) to the specified file
!
!
IMPLICIT NONE
!
INTEGER :: unit = 5, &
ilen, iiarg, nargs, ierr
! do not define iargc as external: g95 does not like it
INTEGER :: iargc
CHARACTER (LEN=80) :: input_file
!
! ... Input from file ?
!
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 )
!
OPEN ( UNIT = unit, FILE = input_file, FORM = 'FORMATTED', &
STATUS = 'OLD', IOSTAT = ierr )
!
CALL errore( 'input_from_file', 'input file ' // TRIM( input_file ) &
& // ' not found' , ierr )
!
END IF
!
END DO
END SUBROUTINE input_from_file
!
!----------------------------------------------------------------------------
SUBROUTINE get_file( input_file )
!
! This subroutine reads, either from command line or from terminal,
! the name of a file to be opened
!
IMPLICIT NONE
!
CHARACTER (LEN=*) :: input_file
!
CHARACTER (LEN=256) :: prgname
! do not define iargc as external: g95 does not like it
INTEGER :: nargs, iargc
LOGICAL :: exst
!
nargs = iargc()
CALL getarg (0,prgname)
!
IF ( nargs == 0 ) THEN
10 PRINT '("Input file > ",$)'
READ (5,'(a)', end = 20, err=20) input_file
IF ( input_file == ' ') GO TO 10
INQUIRE ( FILE = input_file, EXIST = exst )
IF ( .NOT. exst) THEN
PRINT '(A,": file not found")', TRIM(input_file)
GO TO 10
END IF
ELSE IF ( nargs == 1 ) then
CALL getarg (1,input_file)
ELSE
CALL errore( TRIM(prgname), 'too many arguments' , nargs )
END IF
RETURN
20 CALL errore( TRIM(prgname), 'reading file name' , 1 )
!
END SUBROUTINE get_file