TABLE OF CONTENTS
ABINIT/chkdpr [ Functions ]
NAME
chkdpr
FUNCTION
Checks the value of an input real(dp) variable, and write a sophisticated error message when it is erroneous. A few conditions might have been checked before calling chkdpr, and these are mentioned in the error message.
COPYRIGHT
Copyright (C) 1998-2017 ABINIT group (XG) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt . For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
INPUTS
advice_change_cond= if 1, and if an error is detected, will advice to change the value of the conditions. cond_number= number of conditions checked before calling chkdpr. cond_string(cond_number)= name of the variables associated to the conditions. cond_values(cond_number)= value of the variables associated to the conditions. input_name=name of the input variable to be checked input_value=value of the input variable to be checked minimal_flag=if 0, the reference_value must be matched within 1.0d-10 if 1, admit values larger or equal to reference_value if -1, admit values smaller or equal to reference_value reference_value=see the description of minimal_flag unit=unit number for clean output file
OUTPUT
(only side effect)
SIDE EFFECTS
ierr= switch it to 1 if an error was detected. No action otherwise.
NOTES
cond_values(cond_number) must be between -99 and 999 to be printed correctly. for the time being, at most 3 conditions are allowed.
PARENTS
chkinp
CHILDREN
wrtout
SOURCE
52 #if defined HAVE_CONFIG_H 53 #include "config.h" 54 #endif 55 56 #include "abi_common.h" 57 58 59 subroutine chkdpr(advice_change_cond,cond_number,cond_string,cond_values,& 60 & ierr,input_name,input_value,minimal_flag,reference_value,unit) 61 62 use defs_basis 63 use m_errors 64 use m_profiling_abi 65 66 !This section has been created automatically by the script Abilint (TD). 67 !Do not modify the following lines by hand. 68 #undef ABI_FUNC 69 #define ABI_FUNC 'chkdpr' 70 use interfaces_14_hidewrite 71 !End of the abilint section 72 73 implicit none 74 75 !Arguments ------------------------------------ 76 !scalars 77 integer,intent(in) :: advice_change_cond,cond_number,minimal_flag,unit 78 integer,intent(inout) :: ierr 79 real(dp),intent(in) :: input_value,reference_value 80 character(len=*),intent(in) :: input_name 81 !arrays 82 integer,intent(in) :: cond_values(4) 83 character(len=*),intent(in) :: cond_string(4) 84 85 !Local variables------------------------------- 86 !scalars 87 integer :: icond,ok 88 character(len=500) :: message 89 90 !****************************************************************** 91 92 if(cond_number<0 .or. cond_number>4)then 93 write(message,'(a,i6,a)' )& 94 & 'The value of cond_number is',cond_number,& 95 & 'but it should be positive and < 5.' 96 MSG_BUG(message) 97 end if 98 99 !Checks the allowed values 100 ok=0 101 if(minimal_flag==1 .and. input_value>=reference_value-tol10) ok=1 102 if(minimal_flag==-1 .and. input_value<=reference_value+tol10) ok=1 103 if(minimal_flag==0 .and. abs(input_value-reference_value)<=tol10) ok=1 104 105 !If there is something wrong, compose the message, and print it 106 if(ok==0)then 107 ierr=1 108 write(message, '(a,a)' ) ch10,' chkdpr: ERROR -' 109 if(cond_number/=0)then 110 do icond=1,cond_number 111 ! The following format restricts cond_values(icond) to be between -99 and 999 112 write(message, '(2a,a,a,a,i4,a)' ) trim(message),ch10,& 113 & ' Context : the value of the variable ',& 114 & trim(cond_string(icond)),' is',cond_values(icond),'.' 115 end do 116 end if 117 write(message, '(2a,a,a,a,es20.12,a)' ) trim(message),ch10,& 118 & ' The value of the input variable ',trim(input_name),& 119 & ' is',input_value,',' 120 if(minimal_flag==0)then 121 write(message, '(2a,a,es20.12,a)' ) trim(message),ch10,& 122 ' while it must be equal to ',reference_value,'.' 123 else if(minimal_flag==1)then 124 write(message, '(2a,a,es20.12,a)' ) trim(message),ch10,& 125 & ' while it must be larger or equal to',reference_value,'.' 126 else if(minimal_flag==-1)then 127 write(message, '(2a,a,es20.12,a)' ) trim(message),ch10,& 128 & ' while it must be smaller or equal to',reference_value,'.' 129 end if 130 131 if(cond_number==0 .or. advice_change_cond==0)then 132 write(message, '(2a,a,a,a)' ) trim(message),ch10,& 133 & ' Action : you should change the input variable ',trim(input_name),'.' 134 else if(cond_number==1)then 135 write(message, '(2a,a,a,a,a,a)' ) trim(message),ch10,& 136 & ' Action : you should change the input variables ',trim(input_name),& 137 & ' or ',trim(cond_string(1)),'.' 138 else if(cond_number==2)then 139 write(message, '(2a,a,a,a,a,a,a,a,a,a)' ) trim(message),ch10,& 140 & ' Action : you should change one of the input variables ',& 141 & trim(input_name),',',ch10,& 142 & ' ',trim(cond_string(1)),' or ',trim(cond_string(2)),'.' 143 else if(cond_number==3)then 144 write(message, '(2a,a,a,a,a,a,a,a,a,a,a,a)' ) trim(message),ch10,& 145 & ' Action : you should change one of the input variables ',& 146 & trim(input_name),',',ch10,& 147 & ' ',trim(cond_string(1)),', ',trim(cond_string(2)),& 148 & ' or ',trim(cond_string(3)),'.' 149 end if 150 151 call wrtout(unit,message,'COLL') 152 !call wrtout(std_out, message,'COLL') 153 MSG_WARNING(message) 154 end if 155 156 end subroutine chkdpr