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