libtime++: Date and time calculation
time_util_warning.f
Go to the documentation of this file.
1 c this is <time_util_warning.f>
2 c------------------------------------------------------------------------------
3 c
4 c Copyright 2000 by Thomas Forbriger (IfG Stuttgart)
5 c
6 c Print a warning message using FORTRAN i/o routines
7 c
8 c ----
9 c libtime is free software; you can redistribute it and/or modify
10 c it under the terms of the GNU General Public License as published by
11 c the Free Software Foundation; either version 2 of the License, or
12 c (at your option) any later version.
13 c
14 c This program is distributed in the hope that it will be useful,
15 c but WITHOUT ANY WARRANTY; without even the implied warranty of
16 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 c GNU General Public License for more details.
18 c
19 c You should have received a copy of the GNU General Public License
20 c along with this program; if not, write to the Free Software
21 c Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
22 c ----
23 c
24 c
25 c REVISIONS and CHANGES
26 c 05/08/2000 V1.0 Thomas Forbriger
27 c 05/12/2007 V1.1 migration to g77: index function works differently
28 c
29 cS
30 c==============================================================================
31 c
32  subroutine time_util_warning(caller,text)
33 c
34 c declare parameters
35  character*(*) caller,text
36 c
37 cE
38 c declare local variables
39  integer index, last, len
40 c
41 c------------------------------------------------------------------------------
42 c go
43  last=index(caller,' ')-1
44  if (last.lt.1) last=len(caller)
45  print 50,caller(1:last),text
46 c
47  return
48  50 format('WARNING (',a,'): ',a)
49  end
50 c
51 cS
52 c==============================================================================
53 c
54  subroutine time_util_warning_n(caller,text,n)
55 c
56 c declare parameters
57  character*(*) caller,text
58  integer n
59 c
60 cE
61 c declare local variables
62  integer index, last, len
63 c
64 c------------------------------------------------------------------------------
65 c go
66  last=index(caller,' ')-1
67  if (last.lt.1) last=len(caller)
68  print 50,caller(1:last),text,n
69 c
70  return
71  50 format('WARNING (',a,'): ',a,i6)
72  end
73 c
74 c ----- END OF time_util_warning.f -----
subroutine time_util_warning(caller, text)
subroutine time_util_warning_n(caller, text, n)