Skip to content

Commit

Permalink
Input: Remove required flag (Vedran Miletic)
Browse files Browse the repository at this point in the history
svn-origin-rev: 15552
  • Loading branch information
oschuett committed Jul 2, 2015
1 parent 96d1b4f commit 1511745
Show file tree
Hide file tree
Showing 52 changed files with 936 additions and 1,172 deletions.
6 changes: 3 additions & 3 deletions src/environment.F
Original file line number Diff line number Diff line change
Expand Up @@ -740,12 +740,12 @@ SUBROUTINE read_global_section(root_section,para_env,globenv,error)
qmmm_section => section_vals_get_subs_vals3(force_env_sections,"QMMM",&
i_rep_section=i_force_eval(iforce_eval),error=error)
CALL section_vals_val_get(dft_section,"BASIS_SET_FILE_NAME",&
c_val=basis_set_file_name , ignore_required=.TRUE., error=error)
c_val=basis_set_file_name, error=error)
CALL section_vals_val_get(dft_section,"POTENTIAL_FILE_NAME",&
c_val=potential_file_name , ignore_required=.TRUE., error=error)
c_val=potential_file_name, error=error)

CALL section_vals_val_get(qmmm_section,"MM_POTENTIAL_FILE_NAME",&
c_val=mm_potential_file_name, ignore_required=.TRUE., error=error)
c_val=mm_potential_file_name, error=error)
! SUBSYS - If any
subsys_section => section_vals_get_subs_vals3(force_env_sections,"SUBSYS",&
i_rep_section=i_force_eval(iforce_eval),error=error)
Expand Down
2 changes: 1 addition & 1 deletion src/f77_interface.F
Original file line number Diff line number Diff line change
Expand Up @@ -796,7 +796,7 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id,input_declaration,input_path,&
! Setup all possible force_env
force_env_sections => section_vals_get_subs_vals(root_section,"FORCE_EVAL",error=error)
CALL section_vals_val_get(root_section,"MULTIPLE_FORCE_EVALS%MULTIPLE_SUBSYS",&
l_val=multiple_subsys,ignore_required=.TRUE.,error=error)
l_val=multiple_subsys,error=error)
CALL multiple_fe_list(force_env_sections, root_section, i_force_eval, nforce_eval,&
error)
! Enforce the deletion of the subsys (unless not explicitly required)
Expand Down
2 changes: 1 addition & 1 deletion src/force_env_types.F
Original file line number Diff line number Diff line change
Expand Up @@ -755,7 +755,7 @@ SUBROUTINE multiple_fe_list(force_env_sections, root_section, i_force_eval, nfor
! Let's treat the case of Multiple force_eval
CALL section_vals_get(force_env_sections, n_repetition=nforce_eval, error=error)
CALL section_vals_val_get(root_section,"MULTIPLE_FORCE_EVALS%FORCE_EVAL_ORDER",&
i_vals=my_i_force_eval,ignore_required=.TRUE.,error=error)
i_vals=my_i_force_eval,error=error)
ALLOCATE(i_force_eval(nforce_eval),stat=stat)
CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure)
IF (nforce_eval>0) THEN
Expand Down
6 changes: 2 additions & 4 deletions src/force_fields_input.F
Original file line number Diff line number Diff line change
Expand Up @@ -1524,14 +1524,12 @@ SUBROUTINE read_apol_section(apol_atm, apol, damping_list, section,&
damping_list(start_damp+isec_damp)%atm_name2=atm_name
CALL uppercase(damping_list(start_damp+isec_damp)%atm_name2)
CALL section_vals_val_get(tmp_section,"TYPE",i_rep_section=isec_damp,&
c_val=atm_name,ignore_required=.TRUE.,&
error=error)
c_val=atm_name,error=error)
damping_list(start_damp+isec_damp)%dtype=atm_name
CALL uppercase(damping_list(start_damp+isec_damp)%dtype)
CALL section_vals_val_get(tmp_section,"ORDER",i_rep_section=isec_damp,&
i_val=damping_list(start_damp+isec_damp)%order,&
ignore_required=.TRUE., error=error)
i_val=damping_list(start_damp+isec_damp)%order, error=error)
CALL section_vals_val_get(tmp_section,"BIJ",i_rep_section=isec_damp,&
r_val=damping_list(start_damp+isec_damp)%bij, error=error)
CALL section_vals_val_get(tmp_section,"CIJ",i_rep_section=isec_damp,&
Expand Down
4 changes: 2 additions & 2 deletions src/input/cp_output_handling.F
Original file line number Diff line number Diff line change
Expand Up @@ -191,7 +191,7 @@ SUBROUTINE cp_print_key_section_create(print_key_section, name, description, &
IF (PRESENT(print_level)) my_print_level=print_level

CALL section_create(print_key_section,name=name,description=description,&
n_keywords=2, n_subsections=0, repeats=.FALSE., required=.FALSE.,&
n_keywords=2, n_subsections=0, repeats=.FALSE.,&
citations=citations, error=error)

NULLIFY(keyword, subsection)
Expand Down Expand Up @@ -221,7 +221,7 @@ SUBROUTINE cp_print_key_section_create(print_key_section, name, description, &
"separately in ADD_LAST (this mean that each iteration level (MD, GEO_OPT, etc..), "//&
"though equal to 0, might print the last iteration). If an iteration level is specified "//&
"that is not present in the flow of the calculation it is just ignored.",&
n_keywords=2, n_subsections=0, repeats=.FALSE., required=.FALSE.,&
n_keywords=2, n_subsections=0, repeats=.FALSE.,&
citations=citations, error=error)

! Enforce the presence or absence of both.. or give an error
Expand Down
46 changes: 10 additions & 36 deletions src/input/input_keyword_types.F
Original file line number Diff line number Diff line change
Expand Up @@ -71,8 +71,6 @@ MODULE input_keyword_types
!> \param n_var number of values that should be parsed (-1=unknown)
!> \param repeats if the keyword can be present more than once in the
!> section
!> \param required if the keyword is required (leaving it out will give an
!> error)
!> \param enum enumeration that defines the mapping between integers and
!> strings
!> \param unit the default unit this keyword is read in (to automatically
Expand All @@ -93,7 +91,7 @@ MODULE input_keyword_types
CHARACTER,DIMENSION(:),POINTER :: description => Null()
INTEGER, POINTER, DIMENSION(:) :: citations
INTEGER :: type_of_var,n_var
LOGICAL :: repeats, required
LOGICAL :: repeats
TYPE(enumeration_type), POINTER :: enum
TYPE(cp_unit_type), POINTER :: unit
TYPE(val_type), POINTER :: default_value
Expand All @@ -112,7 +110,6 @@ MODULE input_keyword_types
!> \param n_var ...
!> \param repeats ...
!> \param variants ...
!> \param required ...
!> \param default_val ...
!> \param default_l_val ...
!> \param default_r_val ...
Expand Down Expand Up @@ -144,7 +141,7 @@ MODULE input_keyword_types
!> \author fawzi
! *****************************************************************************
SUBROUTINE keyword_create(keyword, name, description, usage, type_of_var,&
n_var,repeats,variants,required,default_val,&
n_var,repeats,variants,default_val,&
default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val,&
default_l_vals, default_r_vals, default_c_vals, default_i_vals,&
lone_keyword_val, lone_keyword_l_val, lone_keyword_r_val, lone_keyword_c_val,&
Expand All @@ -158,7 +155,6 @@ SUBROUTINE keyword_create(keyword, name, description, usage, type_of_var,&
LOGICAL, INTENT(in), OPTIONAL :: repeats
CHARACTER(len=*), DIMENSION(:), &
INTENT(in), OPTIONAL :: variants
LOGICAL, INTENT(in), OPTIONAL :: required
TYPE(val_type), OPTIONAL, POINTER :: default_val
LOGICAL, INTENT(in), OPTIONAL :: default_l_val
REAL(KIND=DP), INTENT(in), OPTIONAL :: default_r_val
Expand Down Expand Up @@ -257,8 +253,6 @@ SUBROUTINE keyword_create(keyword, name, description, usage, type_of_var,&

keyword%repeats=.FALSE.
IF (PRESENT(repeats)) keyword%repeats=repeats
keyword%required=.FALSE.
IF (PRESENT(required)) keyword%required=required

NULLIFY(keyword%enum)
IF (PRESENT(enum)) THEN
Expand Down Expand Up @@ -504,7 +498,6 @@ END SUBROUTINE keyword_release
!> \param n_var ...
!> \param default_value ...
!> \param lone_keyword_value ...
!> \param required ...
!> \param repeats ...
!> \param enum ...
!> \param citations ...
Expand All @@ -513,15 +506,15 @@ END SUBROUTINE keyword_release
!> \author fawzi
! *****************************************************************************
SUBROUTINE keyword_get(keyword,names,usage,description,type_of_var,n_var,&
default_value, lone_keyword_value,required,repeats,enum,citations,error)
default_value, lone_keyword_value,repeats,enum,citations,error)
TYPE(keyword_type), POINTER :: keyword
CHARACTER(len=default_string_length), &
DIMENSION(:), OPTIONAL, POINTER :: names
CHARACTER(len=*), INTENT(out), OPTIONAL :: usage, description
INTEGER, INTENT(out), OPTIONAL :: type_of_var, n_var
TYPE(val_type), OPTIONAL, POINTER :: default_value, &
lone_keyword_value
LOGICAL, INTENT(out), OPTIONAL :: required, repeats
LOGICAL, INTENT(out), OPTIONAL :: repeats
TYPE(enumeration_type), OPTIONAL, &
POINTER :: enum
INTEGER, DIMENSION(:), OPTIONAL, POINTER :: citations
Expand All @@ -543,7 +536,6 @@ SUBROUTINE keyword_get(keyword,names,usage,description,type_of_var,n_var,&
IF (PRESENT(type_of_var)) type_of_var=keyword%type_of_var
IF (PRESENT(n_var)) n_var=keyword%n_var
IF (PRESENT(repeats)) repeats=keyword%repeats
IF (PRESENT(required)) required=keyword%required
IF (PRESENT(default_value)) default_value => keyword%default_value
IF (PRESENT(lone_keyword_value)) lone_keyword_value => keyword%lone_keyword_value
IF (PRESENT(enum)) enum => keyword%enum
Expand All @@ -556,7 +548,7 @@ END SUBROUTINE keyword_get
!> \param keyword the keyword to describe
!> \param unit_nr the unit to write to
!> \param level the description level (0 no description, 1 name
!> 2: +usage, 3: +variants+description+default_value+required+repeats
!> 2: +usage, 3: +variants+description+default_value+repeats
!> 4: +type_of_var)
!> \param error variable to control error logging, stopping,...
!> see module cp_error_handling
Expand Down Expand Up @@ -682,11 +674,6 @@ SUBROUTINE keyword_describe(keyword, unit_nr, level,error)
WRITE(unit_nr,"('lone_keyword : ')",advance="NO")
CALL val_write(keyword%lone_keyword_value,unit_nr=unit_nr,error=error)
END IF
IF (keyword%required) THEN
WRITE(unit_nr,"(' This keyword is required')",advance="NO")
ELSE
WRITE(unit_nr,"(' This keyword is optional')",advance="NO")
END IF
IF (keyword%repeats) THEN
WRITE(unit_nr,"(' and it can be repeated more than once')",advance="NO")
END IF
Expand Down Expand Up @@ -732,11 +719,7 @@ SUBROUTINE keyword_describe_html(keyword, unit_nr, error)
'<TD WIDTH="80%">'
WRITE(unit_nr,'(a)') '<TR><TD WIDTH="20%"><TD WIDTH="80%">'//TRIM(keyword%usage)
WRITE(unit_nr,'(a)') '<TR><TD WIDTH="20%"><TD WIDTH="80%"><i>'//TRIM(a2s(keyword%description))//'</i>'
IF (keyword%required) THEN
WRITE(unit_nr,"(a)",advance="NO") '<TR><TD WIDTH="10%"><TD> This required keyword '
ELSE
WRITE(unit_nr,"(a)",advance="NO") '<TR><TD WIDTH="10%"><TD> This optional keyword '
END IF
WRITE(unit_nr,"(a)",advance="NO") '<TR><TD WIDTH="10%"><TD> This keyword '
SELECT CASE(keyword%type_of_var)
CASE (logical_t)
IF (keyword%n_var==-1) THEN
Expand Down Expand Up @@ -883,7 +866,7 @@ SUBROUTINE write_keyword_xml(keyword,level,unit_number,error)
routineP = moduleN//':'//routineN

CHARACTER(LEN=1000) :: string
CHARACTER(LEN=3) :: repeats, required
CHARACTER(LEN=3) :: repeats
CHARACTER(LEN=8) :: short_string
INTEGER :: i, l0, l1, l2, l3, l4
LOGICAL :: failure
Expand All @@ -902,12 +885,6 @@ SUBROUTINE write_keyword_xml(keyword,level,unit_number,error)
l3 = level + 3
l4 = level + 4

IF (keyword%required) THEN
required = "yes"
ELSE
required = "no "
END IF

IF (keyword%repeats) THEN
repeats = "yes"
ELSE
Expand All @@ -918,18 +895,15 @@ SUBROUTINE write_keyword_xml(keyword,level,unit_number,error)

IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
WRITE (UNIT=unit_number,FMT="(A)")&
REPEAT(" ",l0)//"<SECTION_PARAMETERS required="""//TRIM(required)//&
""" repeats="""//TRIM(repeats)//""">",&
REPEAT(" ",l0)//"<SECTION_PARAMETERS repeats="""//TRIM(repeats)//""">",&
REPEAT(" ",l1)//"<NAME type=""default"">SECTION_PARAMETERS</NAME>"
ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
WRITE (UNIT=unit_number,FMT="(A)")&
REPEAT(" ",l0)//"<DEFAULT_KEYWORD required="""//TRIM(required)//&
""" repeats="""//TRIM(repeats)//""">",&
REPEAT(" ",l0)//"<DEFAULT_KEYWORD repeats="""//TRIM(repeats)//""">",&
REPEAT(" ",l1)//"<NAME type=""default"">DEFAULT_KEYWORD</NAME>"
ELSE
WRITE (UNIT=unit_number,FMT="(A)")&
REPEAT(" ",l0)//"<KEYWORD required="""//TRIM(required)//&
""" repeats="""//TRIM(repeats)//""">",&
REPEAT(" ",l0)//"<KEYWORD repeats="""//TRIM(repeats)//""">",&
REPEAT(" ",l1)//"<NAME type=""default"">"//&
TRIM(keyword%names(1))//"</NAME>"
END IF
Expand Down
Loading

0 comments on commit 1511745

Please sign in to comment.