Check inputs that the user provides for PH and EPW.

The idea is to use check_namelist_read so that the user know
exactly which input variable is problematic.

Also removal of a GOTO statement in epw_readin.f90

This was done by Pietro Delugas, Hari Paudyal and SP.
This commit is contained in:
Samuel Ponce 2020-07-29 10:34:03 +02:00
parent 866b16cc52
commit 0c450d31f5
3 changed files with 105 additions and 97 deletions

View File

@ -71,12 +71,13 @@
USE partial, ONLY : atomo, nat_todo
USE constants, ONLY : AMU_RY, eps16
USE mp_global, ONLY : my_pool_id, me_pool
USE io_global, ONLY : meta_ionode, meta_ionode_id, stdout
USE io_global, ONLY : meta_ionode, meta_ionode_id, stdout, ionode
USE io_var, ONLY : iunkf, iunqf
USE noncollin_module, ONLY : npol, noncolin
USE wvfct, ONLY : npwx
USE paw_variables, ONLY : okpaw
USE io_epw, ONLY : param_get_range_vector
USE read_namelists_module, ONLY : check_namelist_read
#if defined(__NAG)
USE F90_UNIX_ENV, ONLY : iargc, getarg
#endif
@ -128,6 +129,8 @@
!! temp vars for saving kgrid info
INTEGER :: ierr
!! Error status
INTEGER :: unit_loc = 5
!! Unit for input file
!
NAMELIST / inputepw / &
amass, outdir, prefix, iverbosity, fildvscf, &
@ -366,11 +369,11 @@
IF (meta_ionode) THEN
!
! ... Input from file ?
CALL input_from_file( )
CALL input_from_file()
!
! ... Read the first line of the input file
!
READ(5, '(A)', IOSTAT = ios) title
READ(unit_loc, '(A)', IOSTAT = ios) title
!
ENDIF
!
@ -383,13 +386,11 @@
IF (imatches("&inputepw", title)) THEN
WRITE(*, '(6x,a)') "Title line not specified: using 'default'."
title = 'default'
IF (meta_ionode) REWIND(5, IOSTAT = ios)
IF (meta_ionode) REWIND(unit_loc, IOSTAT = ios)
CALL mp_bcast(ios, meta_ionode_id, world_comm )
CALL errore('epw_readin', 'Title line missing from input.', ABS(ios))
ENDIF
!
IF (.NOT. meta_ionode) GOTO 400
!
! Set default values for variables in namelist
amass(:) = 0.d0
iverbosity = 0
@ -607,43 +608,49 @@
! ---------------------------------------------------------------------------------
!
! Reading the namelist inputepw
!
IF (meta_ionode) THEN
READ(unit_loc, inputepw, IOSTAT = ios)
ENDIF ! meta_ionode
!
#if defined(__CRAYY)
! The Cray does not accept "err" and "iostat" together with a namelist
READ(5, inputepw)
ios = 0
#else
!
IF (meta_ionode) READ(5, inputepw, ERR = 200, IOSTAT = ios)
#endif
200 CALL errore('epw_readin', 'reading input_epw namelist', ABS(ios))
!
IF (wannier_plot) THEN
IF (wannier_plot_radius < 0.0d0) &
CALL errore('epw_readin', 'Error: wannier_plot_radius must be positive', 1)
IF (wannier_plot_scale < 0.0d0) &
CALL errore('epw_readin', 'Error: wannier_plot_scale must be positive', 1)
IF (ANY(wannier_plot_supercell <= 0)) &
CALL errore('epw_readin', &
'Error: Three positive integers must be explicitly provided &
for wannier_plot_supercell', 1)
CALL param_get_range_vector(wannier_plot_list, num_wannier_plot, .TRUE.)
IF (num_wannier_plot == 0) THEN
num_wannier_plot = nbndsub
ALLOCATE(wanplotlist(num_wannier_plot), STAT = ierr)
IF (ierr /= 0) CALL errore('epw_readin', 'Error allocating wanplotlist', 1)
DO i = 1, num_wannier_plot
wanplotlist(i) = i
ENDDO
ELSE
ALLOCATE(wanplotlist(num_wannier_plot), STAT = ierr)
IF (ierr /= 0) CALL errore('epw_readin', 'Error allocating wanplotlist', 1)
CALL param_get_range_vector(wannier_plot_list, num_wannier_plot, .FALSE., wanplotlist)
IF (ANY(wanplotlist < 1) .OR. ANY(wanplotlist > nbndsub)) &
! If an input does not belong to the input namelist, return which one to the user.
CALL check_namelist_read(ios, unit_loc, "inputepw")
!
IF (meta_ionode) THEN
IF (wannier_plot) THEN
IF (wannier_plot_radius < 0.0d0) &
CALL errore('epw_readin', 'Error: wannier_plot_radius must be positive', 1)
IF (wannier_plot_scale < 0.0d0) &
CALL errore('epw_readin', 'Error: wannier_plot_scale must be positive', 1)
IF (ANY(wannier_plot_supercell <= 0)) &
CALL errore('epw_readin', &
'Error: wannier_plot_list asks for a non-valid wannier function to be plotted', 1)
'Error: Three positive integers must be explicitly provided &
for wannier_plot_supercell', 1)
CALL param_get_range_vector(wannier_plot_list, num_wannier_plot, .TRUE.)
IF (num_wannier_plot == 0) THEN
num_wannier_plot = nbndsub
ALLOCATE(wanplotlist(num_wannier_plot), STAT = ierr)
IF (ierr /= 0) CALL errore('epw_readin', 'Error allocating wanplotlist', 1)
DO i = 1, num_wannier_plot
wanplotlist(i) = i
ENDDO
ELSE
ALLOCATE(wanplotlist(num_wannier_plot), STAT = ierr)
IF (ierr /= 0) CALL errore('epw_readin', 'Error allocating wanplotlist', 1)
CALL param_get_range_vector(wannier_plot_list, num_wannier_plot, .FALSE., wanplotlist)
IF (ANY(wanplotlist < 1) .OR. ANY(wanplotlist > nbndsub)) &
CALL errore('epw_readin', &
'Error: wannier_plot_list asks for a non-valid wannier function to be plotted', 1)
ENDIF
ENDIF
ENDIF ! meta_ionode
CALL mp_bcast(wannier_plot, meta_ionode_id, world_comm)
IF (wannier_plot) CALL mp_bcast(num_wannier_plot, meta_ionode_id, world_comm)
IF ((wannier_plot) .AND. (.NOT. meta_ionode)) THEN
ALLOCATE(wanplotlist(num_wannier_plot), STAT = ierr)
IF (ierr /= 0) CALL errore('epw_readin', 'Error allocating wanplotlist', 1)
ENDIF
IF (wannier_plot) CALL mp_bcast(wanplotlist, meta_ionode_id, world_comm)
!
nk1tmp = nk1
nk2tmp = nk2
@ -701,8 +708,7 @@
IF (ephwrite) THEN
IF (.NOT. ep_coupling .AND. .NOT. elph) CALL errore('epw_readin', &
'ephwrite requires ep_coupling=.TRUE., elph=.TRUE.', 1)
IF (rand_k .OR. rand_q) &
CALL errore('epw_readin', 'ephwrite requires a uniform grid', 1)
IF (rand_k .OR. rand_q) CALL errore('epw_readin', 'ephwrite requires a uniform grid', 1)
IF (MOD(nkf1,nqf1) /= 0 .OR. MOD(nkf2,nqf2) /= 0 .OR. MOD(nkf3,nqf3) /= 0) &
CALL errore('epw_readin', 'ephwrite requires nkf1,nkf2,nkf3 to be multiple of nqf1,nqf2,nqf3', 1)
ENDIF
@ -733,17 +739,21 @@
IF (lscreen .AND. etf_mem == 2) CALL errore('epw_readin', 'Error: lscreen not implemented with etf_mem=2', 1)
IF (ABS(degaussw) < eps16 .AND. etf_mem == 2) CALL errore('epw_readin', &
'Error: adapt_smearing not implemented with etf_mem=2', 1)
!
! Make sure the files exists
IF (filkf /= ' ') THEN
OPEN(UNIT = iunkf, FILE = filkf, STATUS = 'old', FORM = 'formatted', ERR = 100, IOSTAT = ios)
100 CALL errore('epw_readin', 'opening file ' // filkf, ABS(ios))
CLOSE(iunkf)
ENDIF
IF (filqf /= ' ') THEN
OPEN(UNIT = iunqf, FILE = filqf, STATUS = 'old', FORM = 'formatted', ERR = 101, IOSTAT = ios)
101 CALL errore('epw_readin', 'opening file ' // filqf, ABS(ios))
CLOSE(iunqf)
ENDIF
!
IF (meta_ionode) THEN
IF (filkf /= ' ') THEN
OPEN(UNIT = iunkf, FILE = filkf, STATUS = 'old', FORM = 'formatted', ERR = 100, IOSTAT = ios)
100 CALL errore('epw_readin', 'opening file ' // filkf, ABS(ios))
CLOSE(iunkf)
ENDIF
IF (filqf /= ' ') THEN
OPEN(UNIT = iunqf, FILE = filqf, STATUS = 'old', FORM = 'formatted', ERR = 101, IOSTAT = ios)
101 CALL errore('epw_readin', 'opening file ' // filqf, ABS(ios))
CLOSE(iunqf)
ENDIF
ENDIF ! meta_ionode
IF (iterative_bte) THEN
! The fine grids have to be homogeneous and the same. Otherwise the populations can oscillate.
IF (nkf1 /= nqf1 .OR. nkf2 /= nqf2 .OR. nkf3 /= nqf3) THEN
@ -761,14 +771,14 @@
WRITE(stdout, '(5x,a)') " to control the lower bound of band manifold."
ENDIF
!
! setup temperature array
! Setup temperature array
DO itemp = 1, ntempxx
IF (temps(itemp) > 0.d0) THEN
nstemp_hold = itemp
ENDIF
ENDDO
!
!case of nstemp > 0 but temps(:) = 0 is caught above
! Case of nstemp > 0 but temps(:) = 0 is caught above
IF (nstemp_hold == 0 .AND. nstemp == 0) THEN !default mode (nstemp_hold == 0 if temps(:) = 0)
nstemp = 1
temps(1) = 300
@ -784,17 +794,14 @@
ELSE
DO itemp = 1, nstemp
temps(itemp) = tempsmin + DBLE(itemp - 1) * (tempsmax - tempsmin) / DBLE(nstemp - 1)
END DO
END IF
ENDDO
ENDIF
WRITE(stdout, '(/,5x,a)') 'Generating evenly spaced temperature list.'
ELSE IF (nstemp_hold .NE. nstemp) THEN !temps and nstemp not match
! Ignore nstemp setting, print warning
WRITE(stdout, '(/,5x,a)') 'WARNING: Mismatch between temps(:) and nstemp'
WRITE(stdout, '(/,5x,a)') 'WARNING: Using supplied temperature list and ignoring nstemp'
nstemp = nstemp_hold
! CALL errore('epw_readin', 'Error: too many temperatures for given nstemp', 1)
! ELSE IF (nstemp > nstemp_hold) THEN !need more temps
! CALL errore('epw_readin', 'Error: not enough temperatures given in temps(:)', 1)
ELSE
CALL errore('epw_readin', 'Error generating temperatures: unknown error', 1)
END IF
@ -828,14 +835,11 @@
ENDIF
! eptemp : temperature for the electronic Fermi occupations in the e-p calculation (units of Kelvin)
! 1 K in eV = 8.6173423e-5
! from K to Ryd
! Out-of bound issue with GCC compiler. Multiple Fermi temp is not used anyway.
!
! from cm-1 to Ryd
eps_acustic = eps_acustic / ev2cmm1 / ryd2ev
!
! reads the q point (just if ldisp = .FALSE.)
!
! wmin and wmax from eV to Ryd
wmin = wmin / ryd2ev
wmax = wmax / ryd2ev
@ -844,7 +848,7 @@
wmin_specfun = wmin_specfun / ryd2ev
wmax_specfun = wmax_specfun / ryd2ev
!
! scissor going from eV to Ryd
! Scissor going from eV to Ryd
scissor = scissor / ryd2ev
!
! Photon energies for indirect absorption from eV to Ryd
@ -857,24 +861,7 @@
tmp_dir = TRIM(outdir)
dvscf_dir = TRIM(dvscf_dir) // '/'
!
400 CONTINUE
!
CALL mp_bcast(wannier_plot, meta_ionode_id, world_comm)
CALL mp_bcast(num_wannier_plot, meta_ionode_id, world_comm)
IF ((wannier_plot) .AND. (.NOT. meta_ionode)) THEN
ALLOCATE(wanplotlist(num_wannier_plot), STAT = ierr)
IF (ierr /= 0) CALL errore('epw_readin', 'Error allocating wanplotlist', 1)
ENDIF
IF (wannier_plot) CALL mp_bcast(wanplotlist, meta_ionode_id, world_comm)
!
CALL bcast_epw_input()
IF (.NOT. meta_ionode) THEN
! need to allocate gtemp after the initial bcast_epw_input so all nodes have nstemp
ALLOCATE(gtemp(nstemp), STAT = ierr)
IF (ierr /= 0) CALL errore('epw_readin', 'Error allocating gtemp', 1)
ENDIF
!bcast gtemp following allocation
CALL mp_bcast(gtemp, meta_ionode_id, world_comm)
!
! Here we finished the reading of the input file.
! Now allocate space for pwscf variables, read and check them.

View File

@ -13,11 +13,16 @@ SUBROUTINE input_from_file( )
!
IMPLICIT NONE
!
INTEGER :: stdin = 5, stderr = 6, ierr = 0
CHARACTER (LEN=256) :: input_file
LOGICAL :: found
INTEGER :: stdin = 5, stderr = 6, ierr = 0
CHARACTER(LEN = 256) :: input_file
LOGICAL :: found
!
INTEGER :: iiarg, nargs
CHARACTER(LEN = 512) :: dummy
!! Read dummy line
INTEGER :: iiarg, nargs, stdtmp
!
INTEGER, EXTERNAL :: find_free_unit
!! Find unit number that is free
!
nargs = command_argument_count()
found = .FALSE.
@ -41,20 +46,33 @@ SUBROUTINE input_from_file( )
END DO
!
IF ( found ) THEN
!
OPEN ( UNIT = stdin, FILE = input_file, FORM = 'FORMATTED', &
STATUS = 'OLD', IOSTAT = ierr )
!
! TODO: return error code ierr (-1 no file, 0 file opened, > 1 error)
! do not call "errore" here: it may hang in parallel execution
! if this routine is called by a single processor
!
IF ( ierr > 0 ) WRITE (stderr, &
'(" *** input file ",A," not found ***")' ) TRIM( input_file )
!
!
OPEN ( UNIT = stdin, FILE = input_file, FORM = 'FORMATTED', &
STATUS = 'OLD', IOSTAT = ierr )
!
! TODO: return error code ierr (-1 no file, 0 file opened, > 1 error)
! do not call "errore" here: it may hang in parallel execution
! if this routine is called by a single processor
!
IF ( ierr > 0 ) WRITE (stderr, &
'(" *** input file ",A," not found ***")' ) TRIM( input_file )
!
ELSE
ierr = -1
END IF
input_file="input_tmp.in"
stdtmp = find_free_unit()
OPEN(UNIT = stdtmp, FILE = TRIM(input_file), FORM = "formatted", &
STATUS = "unknown", IOSTAT = ierr)
IF (ierr > 0) CALL errore("input_file","unable to open file input_tmp.in", ierr)
ierr = -1
DO
READ(stdin, fmt = '(A512)',END = 30) dummy
WRITE(stdtmp, '(A)') TRIM(dummy)
CYCLE
30 EXIT
ENDDO
CLOSE(UNIT = stdtmp, STATUS = 'keep')
OPEN(UNIT = stdin, FILE = input_file, FORM = 'FORMATTED', STATUS = 'OLD', IOSTAT = ierr)
ENDIF
!
RETURN
!

View File

@ -78,6 +78,7 @@ SUBROUTINE phq_readin()
do_charge_neutral, wpot_dir
USE ahc, ONLY : elph_ahc, ahc_dir, ahc_nbnd, ahc_nbndskip, &
skip_upperfan
USE read_namelists_module, ONLY : check_namelist_read
!
IMPLICIT NONE
!
@ -340,7 +341,8 @@ SUBROUTINE phq_readin()
! ... reading the namelist inputph
!
IF (meta_ionode) THEN
READ( 5, INPUTPH, ERR=30, IOSTAT = ios )
!READ( 5, INPUTPH, ERR=30, IOSTAT = ios )
READ( 5, INPUTPH, IOSTAT = ios )
!
! ... iverbosity/verbosity hack
!
@ -357,6 +359,7 @@ SUBROUTINE phq_readin()
ios = 1234567
END IF
END IF
CALL check_namelist_read(ios, 5, "inputph")
30 CONTINUE
CALL mp_bcast(ios, meta_ionode_id, world_comm )
IF ( ios == 1234567 ) THEN