TABLE OF CONTENTS


ABINIT/chkdpr [ Functions ]

[ Top ] [ 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