1!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch, M. Oliveira
2!!
3!! This program is free software; you can redistribute it and/or modify
4!! it under the terms of the GNU General Public License as published by
5!! the Free Software Foundation; either version 2, or (at your option)
6!! any later version.
7!!
8!! This program is distributed in the hope that it will be useful,
9!! but WITHOUT ANY WARRANTY; without even the implied warranty of
10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11!! GNU General Public License for more details.
12!!
13!! You should have received a copy of the GNU General Public License
14!! along with this program; if not, write to the Free Software
15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16!! 02110-1301, USA.
17!!
18
19#include "global.h"
20
21module loct_oct_m
22
23  implicit none
24
25  !> Define which routines can be seen from the outside
26  private
27  public ::                  &
28    loct_clock,              &
29    loct_gettimeofday,       &
30    loct_nanosleep,          &
31    loct_getcwd,             &
32    loct_dirname,            &
33    loct_basename,           &
34    loct_realpath,           &
35    loct_sysname,            &
36    loct_search_file_lr,     &
37    loct_mkdir,              &
38    loct_stat,               &
39    loct_rm,                 &
40    loct_dir_exists,         &
41    loct_number_of_lines,    &
42    loct_break_C_string,     &
43    loct_getenv,             &
44    loct_isinstringlist,     &
45    loct_progress_bar,       &
46    loct_printRecipe,        &
47    loct_strerror,           &
48    loct_get_memory_usage,   &
49    loct_exit_failure
50
51  ! ---------------------------------------------------------
52  !> System information (time, memory, sysname)
53
54  interface loct_strerror
55    subroutine oct_strerror(errno, res)
56      implicit none
57      integer, intent(in) :: errno
58      character(len=*), intent(out)  :: res
59    end subroutine oct_strerror
60  end interface loct_strerror
61
62  interface loct_clock
63    function oct_clock()
64     implicit none
65      real(8) :: oct_clock
66    end function oct_clock
67  end interface loct_clock
68
69  interface loct_gettimeofday
70    subroutine oct_gettimeofday(sec, usec)
71      implicit none
72      integer, intent(out) :: sec, usec
73    end subroutine oct_gettimeofday
74  end interface loct_gettimeofday
75
76  interface loct_nanosleep
77    subroutine oct_nanosleep(sec, nsec)
78      implicit none
79      integer, intent(in) :: sec  !< number of seconds
80      integer, intent(in) :: nsec !< + number of nanoseconds
81    end subroutine oct_nanosleep
82  end interface loct_nanosleep
83
84  interface loct_sysname
85    subroutine oct_sysname(name)
86      implicit none
87      character(len=*), intent(out) :: name
88    end subroutine oct_sysname
89  end interface loct_sysname
90
91  interface loct_getcwd
92    subroutine oct_getcwd(name)
93      implicit none
94      character(len=*), intent(out) :: name
95    end subroutine oct_getcwd
96  end interface loct_getcwd
97
98  interface loct_realpath
99    subroutine oct_realpath(fnam, rnam)
100      character(len=*), intent(in)  :: fnam
101      character(len=*), intent(out) :: rnam
102    end subroutine oct_realpath
103  end interface
104
105  interface loct_dirname
106    subroutine oct_dirname(fnam, dnam)
107      character(len=*), intent(in)  :: fnam
108      character(len=*), intent(out) :: dnam
109    end subroutine oct_dirname
110  end interface
111
112  interface loct_basename
113     subroutine oct_basename(fnam, dnam)
114       character(len=*), intent(in)  :: fnam
115       character(len=*), intent(out) :: dnam
116     end subroutine oct_basename
117  end interface
118
119
120  ! ---------------------------------------------------------
121  !> File-handling
122  interface loct_mkdir
123    subroutine oct_mkdir(name)
124      implicit none
125      character(len=*), intent(in) :: name
126    end subroutine oct_mkdir
127  end interface loct_mkdir
128
129  interface loct_stat
130    subroutine oct_stat(ierr, name, mod_time)
131      implicit none
132      integer,          intent(out) :: ierr
133      character(len=*), intent(in)  :: name
134      character(len=*), intent(out) :: mod_time
135    end subroutine oct_stat
136  end interface loct_stat
137
138  interface loct_rm
139    subroutine oct_rm(name)
140      implicit none
141      character(len=*), intent(in) :: name
142    end subroutine oct_rm
143  end interface loct_rm
144
145  interface loct_number_of_lines
146    integer function oct_number_of_lines(filename)
147      implicit none
148      character(len=*), intent(in) :: filename
149    end function oct_number_of_lines
150  end interface loct_number_of_lines
151
152  interface loct_break_C_string
153    subroutine oct_break_C_string(str, s, line)
154      use iso_c_binding
155      implicit none
156      type(c_ptr),       intent(in)    :: str
157      type(c_ptr),       intent(inout) :: s
158      character(len=*),  intent(out)   :: line
159    end subroutine oct_break_C_string
160  end interface loct_break_C_string
161
162  interface loct_search_file_lr
163    subroutine oct_search_file_lr(freq, tag, ierr, dirname)
164      implicit none
165      REAL_DOUBLE,      intent(inout) :: freq
166      integer,          intent(in)    :: tag
167      integer,          intent(out)   :: ierr
168      character(len=*), intent(in)    :: dirname
169    end subroutine oct_search_file_lr
170  end interface loct_search_file_lr
171
172  ! ---------------------------------------------------------
173  !> Varia
174  interface loct_getenv
175    subroutine oct_getenv(var, val)
176      implicit none
177      character(len=*), intent(in)  :: var
178      character(len=*), intent(out) :: val
179    end subroutine oct_getenv
180  end interface loct_getenv
181
182  interface loct_progress_bar
183    subroutine oct_progress_bar(a, maxcount)
184      implicit none
185      integer, intent(in) :: a, maxcount
186    end subroutine oct_progress_bar
187  end interface loct_progress_bar
188
189  interface loct_printRecipe
190    subroutine oct_printRecipe(dir, filename)
191      implicit none
192      character(len=*), intent(in)  :: dir
193      character(len=*), intent(out) :: filename
194    end subroutine oct_printRecipe
195  end interface loct_printRecipe
196
197  interface loct_exit_failure
198    subroutine oct_exit_failure()
199      implicit none
200    end subroutine oct_exit_failure
201  end interface loct_exit_failure
202
203  interface loct_wfs_list
204    subroutine oct_wfs_list(str, l)
205      implicit none
206      character(len=*), intent(in)  :: str
207      integer,          intent(out) :: l !< array
208    end subroutine oct_wfs_list
209  end interface loct_wfs_list
210
211 interface loct_get_memory_usage
212   integer(SIZEOF_VOIDP) function oct_get_memory_usage()
213     implicit none
214   end function oct_get_memory_usage
215 end interface loct_get_memory_usage
216
217contains
218
219  logical function loct_isinstringlist(a, s) result(inlist)
220    integer,          intent(in) :: a
221    character(len=*), intent(in) :: s
222
223    integer, allocatable :: list(:)
224
225    allocate(list(2**14))
226
227    call loct_wfs_list(s, list(1))
228    inlist = .false.
229    if (list(a) == 1) inlist = .true.
230
231    deallocate(list)
232
233  end function loct_isinstringlist
234
235
236  logical function loct_dir_exists(dirname) result(exists)
237    character(len=*), intent(in) :: dirname
238
239    interface oct_dir_exists
240      integer function oct_dir_exists(dirname)
241        implicit none
242        character(len=*), intent(in)    :: dirname
243      end function oct_dir_exists
244    end interface oct_dir_exists
245
246    exists = oct_dir_exists(dirname) /= 0
247
248  end function loct_dir_exists
249
250end module loct_oct_m
251
252!! Local Variables:
253!! mode: f90
254!! coding: utf-8
255!! End:
256