NCEPLIBS-bufr  12.2.0
borts.F90
Go to the documentation of this file.
1 
5 
14 recursive subroutine bort(str)
15 
16  use bufrlib
17 
18  use moda_borts
19 
20  implicit none
21 
22  character*(*), intent(in) :: str
23 
24  if (bort_catch == 'Y') then
25  call strsuc(str, caught_str, caught_str_len)
26  call bort_goto_target_c()
27  endif
28 
29  call errwrt(' ')
30  call errwrt('***********BUFR ARCHIVE LIBRARY ABORT**************')
31  call errwrt(str)
32  call errwrt('***********BUFR ARCHIVE LIBRARY ABORT**************')
33  call errwrt(' ')
34  stop 8
35 
36 end subroutine bort
37 
47 recursive subroutine bort2(str1,str2)
48 
49  use bufrlib
50 
51  use moda_borts
52 
53  implicit none
54 
55  character*(*), intent(in) :: str1, str2
56 
57  if (bort_catch == 'Y') then
58  call strsuc(str1, caught_str, caught_str_len)
59  caught_str = str1(1:caught_str_len) // str2
60  call strsuc(caught_str, caught_str, caught_str_len)
61  call bort_goto_target_c()
62  endif
63 
64  call errwrt(' ')
65  call errwrt('***********BUFR ARCHIVE LIBRARY ABORT**************')
66  call errwrt(str1)
67  call errwrt(str2)
68  call errwrt('***********BUFR ARCHIVE LIBRARY ABORT**************')
69  call errwrt(' ')
70  stop 8
71 
72 end subroutine bort2
73 
118 integer function catch_borts(cbc) result (iret)
119 
120  use modv_vars, only: iprt
121 
122  use moda_borts
123 
124  implicit none
125 
126  character, intent(in) :: cbc
127  character my_cbc
128 
129  iret = 0
130  my_cbc = cbc
131  call capit(my_cbc)
132  if (iprt >= 1) call errwrt('++++++++++++++++++WARNING+++++++++++++++++++')
133 
134  if (my_cbc == 'Y') then
135  bort_catch = my_cbc
136  bort_target_is_unset = .true.
137  if (iprt >= 1) call errwrt('BUFRLIB: CATCH_BORTS - ENABLING BORT CATCHING')
138  else if (my_cbc == 'N') then
139  bort_catch = my_cbc
140  bort_target_is_unset = .false.
141  if (iprt >= 1) call errwrt('BUFRLIB: CATCH_BORTS - DISABLING BORT CATCHING')
142  else
143  iret = -1
144  if (iprt >= 1) call errwrt('BUFRLIB: CATCH_BORTS - ILLEGAL INPUT VALUE; NO ACTION WAS TAKEN')
145  endif
146 
147  if (iprt >= 1) call errwrt('++++++++++++++++++WARNING+++++++++++++++++++')
148 
149  return
150 end function catch_borts
151 
165 recursive subroutine check_for_bort(bort_str, bort_str_len)
166 
167  use modv_vars, only: iprt, im8b
168 
169  use moda_borts
170 
171  implicit none
172 
173  character*(*), intent(out) :: bort_str
174 
175  integer, intent(out) :: bort_str_len
176 
177  ! Check for I8 integers
178 
179  if(im8b) then
180  im8b = .false.
181  call check_for_bort(bort_str,bort_str_len)
182  call x48(bort_str_len,bort_str_len,1)
183  im8b = .true.
184  return
185  endif
186 
187  if (bort_catch == 'N') then
188  if (iprt >= 1) then
189  call errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
190  call errwrt('BUFRLIB: CHECK_FOR_BORT WAS CALLED WITHOUT HAVING PREVIOUSLY CALLED CATCH_BORTS')
191  call errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
192  endif
193  bort_str_len = -1
194  else if (caught_str_len == 0) then
195  bort_str_len = 0
196  bort_str = ' '
197  else
198  bort_str_len = min(len(bort_str),caught_str_len)
199  bort_str = caught_str(1:bort_str_len)
200  endif
201 
202  return
203 end subroutine check_for_bort
check_for_bort
recursive subroutine check_for_bort(bort_str, bort_str_len)
Check whether a bort error occurred during a previous call to an NCEPLIBS-bufr subroutine or function...
Definition: borts.F90:166
bort
recursive subroutine bort(str)
Log an error message, then either return to or abort the application program.
Definition: borts.F90:15
catch_borts
integer function catch_borts(cbc)
Specify whether subsequent bort errors should be caught and returned to the application program.
Definition: borts.F90:119
bort2
recursive subroutine bort2(str1, str2)
Log two error messages, then either return to or abort the application program.
Definition: borts.F90:48
errwrt
subroutine errwrt(str)
Specify a custom location for the logging of error and diagnostic messages generated by the NCEPLIBS-...
Definition: errwrt.F90:32
bufrlib::bort_goto_target_c
Definition: bufrlib.F90:340
strsuc
subroutine strsuc(str1, str2, lens)
Remove leading and trailing blanks from a character string.
Definition: misc.F90:199
capit
subroutine capit(str)
Capitalize all of the alphabetic characters in a string.
Definition: misc.F90:334
bufrlib
Wrap C NCEPLIBS-bufr functions so they can be called from within the Fortran part of the library.
Definition: bufrlib.F90:11
moda_borts
Declare variables used to optionally catch and return any future bort error string to the application...
Definition: modules_arrs.F90:910
moda_borts::caught_str_len
integer caught_str_len
Length of bort error string.
Definition: modules_arrs.F90:922
moda_borts::bort_catch
character bort_catch
Flag indicating whether bort errors generated during all future calls to NCEPLIBS-bufr subroutines an...
Definition: modules_arrs.F90:916
moda_borts::caught_str
character *300 caught_str
Bort error string.
Definition: modules_arrs.F90:920
moda_borts::bort_target_is_unset
logical bort_target_is_unset
.true.
Definition: modules_arrs.F90:918
x48
subroutine x48(iin4, iout8, nval)
Encode one or more 4-byte integer values as 8-byte integer values.
Definition: x4884.F90:18