Octopus
oct_f.c
Go to the documentation of this file.
1/*
2 Copyright (C) 2002 M. Marques, A. Castro, A. Rubio, G. Bertsch
3
4 This program is free software; you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation; either version 2, or (at your option)
7 any later version.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License
15 along with this program; if not, write to the Free Software
16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17 02110-1301, USA.
18
19*/
20
21#include <config.h>
22
23#include <assert.h>
24#include <ctype.h>
25#include <libgen.h>
26#include <math.h>
27#include <stdio.h>
28#include <stdlib.h>
29#include <string.h>
30#include <time.h>
31#if __has_include(<unistd.h>)
32#include <unistd.h>
33#endif
34
35#include <fortran_types.h>
36
37#ifdef _POSIX_VERSION
38#include <dirent.h>
39#include <sys/stat.h>
40#include <sys/time.h>
41#include <sys/types.h>
42#endif
43
44/* needed for getting executable path on Mac */
45#if defined(__APPLE__) && defined(__MACH__)
46#include <mach-o/dyld.h>
47#endif
49#if defined(__FreeBSD__)
50#include <sys/sysctl.h>
51#endif
52
53/* *********************** interface functions ********************** */
54
55void oct_mkdir(char * name_c) {
56 struct stat buf;
57
58 if (!*name_c)
59 return;
60
61 if (stat(name_c, &buf) == 0) {
62 return;
63 }
64
65#ifndef _WIN32
66 mkdir(name_c, 0775);
67#else
68 mkdir(name_c);
69#endif
70
71}
72
73void oct_stat(fint *ierr, char * name_c,
74 char * mod_time_c) {
75 struct stat statbuf;
76 time_t mtime;
77 struct tm *timeinfo;
79 *ierr = stat(name_c, &statbuf);
81 if (*ierr == 0) {
82 mtime = statbuf.st_mtime; /* last modification time */
83 timeinfo = localtime(&mtime);
84 mod_time_c = asctime(timeinfo);
85 } else {
86 perror(name_c); /* what is the problem? */
87 mod_time_c = malloc(sizeof(char));
88 mod_time_c[0] = '\0';
89 }
91 if (*ierr != 0) {
92 printf("ierr = %i\n", *ierr);
93 }
94 /* otherwise, do not do this since 'mod_time_c' points at static data of
95 * asctime */
96}
97
98int oct_dir_exists(char * name_c) {
99 int ierr;
100 struct stat statbuf;
102 ierr = stat(name_c, &statbuf);
104 if (ierr == 0) {
105 return S_ISDIR(statbuf.st_mode);
106 } else {
107 return 0;
108 }
111void oct_rm(char * name_c) {
112 unlink(name_c);
113}
114
115void oct_getcwd(char * name) {
116 getcwd(name, 256);
117}
119void oct_realpath(char * fn, char * rn) {
120 char* tmp = NULL;
121 tmp = realpath(fn, NULL);
122 strcpy(rn, tmp);
123 free(tmp);
124}
125
126void oct_dirname(char * fn, char * dn) {
127 strcpy(dn, dirname(fn));
130void oct_basename(char * fn, char * bn) {
131 strcpy(bn, basename(fn));
134void oct_getenv(char * name_c, char * var_c) {
135 char* tmp = NULL;
136 tmp = getenv(name_c);
137 if (tmp != NULL) {
138 strcpy(var_c, tmp);
140 else {
141 strcpy(var_c, "");
145/* this function gets a string of the form '1-12, 34' and fills
146 array l with the 1 if the number is in the list, or 0 otherwise */
147void oct_wfs_list(char * str_c, fint l[16384]) {
148 int i, i1, i2;
149 char c[20], *c1, *s;
150
151 s = str_c;
152
153 /* clear list */
154 for (i = 0; i < 16384; i++)
155 l[i] = 0;
156
157 while (*s) {
158 /* get integer */
159 for (c1 = c; isdigit(*s) || isspace(*s); s++)
160 if (isdigit(*s))
161 *c1++ = *s;
162 *c1 = '\0';
163 i1 = atoi(c) - 1;
164
165 if (*s == '-') { /* range */
166 s++;
167 for (c1 = c; isdigit(*s) || isspace(*s); s++)
168 if (isdigit(*s))
169 *c1++ = *s;
170 *c1 = '\0';
171 i2 = atoi(c) - 1;
172 } else /* single value */
173 i2 = i1;
175 for (i = i1; i <= i2; i++)
176 if (i >= 0 && i < 16384)
177 l[i] = 1;
178
179 if (*s)
180 s++;
182}
183
184/* ------------------------------ from varia.c -------------------------------
185 */
186#include "varia.h"
187
188void FC_FUNC_(oct_progress_bar, OCT_PROGRESS_BAR)(fint *a, fint *max) {
189 if (*max == 0)
190 return; /* Skip the bar if the length is 0 */
191 progress_bar(*a, *max);
193
194/* ------------------------------ some stuff --------------------------------
195 */
196void FC_FUNC_(oct_gettimeofday, OCT_GETTIMEOFDAY)(fint *sec, fint *usec) {
197#ifdef _POSIX_VERSION
198 struct timeval tv;
199
200 gettimeofday(&tv, NULL);
201
202 /* The typecast below should use long. However, this causes incompatibilities
203 with Fortran integers.
204 Using int will cause wrong results when tv.tv_sec exceeds
205 INT_MAX=2147483647 */
206 *sec = (int)tv.tv_sec;
207 *usec = (int)tv.tv_usec;
208/*
209 char str[sizeof("HH:MM:SS")];
210 time_t local;
211 local = tv.tv_sec;
212 strftime(str, sizeof(str), "%T", localtime(&local));
213 printf("%s.%06ld \n", str, (long) tv.tv_usec);
214 printf("%ld.%06ld \n", (long) tv.tv_sec, (long) tv.tv_usec);
216#else
217 *sec = 0;
218 *usec = 0;
219#endif
222double FC_FUNC_(oct_clock, OCT_CLOCK)() {
223#ifdef _POSIX_VERSION
224 int sec, usec;
225 FC_FUNC_(oct_gettimeofday, OCT_GETTIMEOFDAY)(&sec, &usec);
226 return sec + 1.0e-6 * usec;
227#else
228 return (double)clock() / CLOCKS_PER_SEC;
229#endif
230}
231
232void FC_FUNC_(oct_nanosleep, OCT_NANOSLEEP)(fint *sec, fint *nsec) {
233#ifdef _POSIX_VERSION
234 /* Datatypes should be long instead of int (see comment in gettimeofday) */
235 struct timespec req;
236 req.tv_sec = (time_t)*sec;
237 req.tv_nsec = (long)*nsec;
238 nanosleep(&req, NULL);
239#endif
240}
241
242void oct_sysname(char * name_c) {
243
244 char* tmp = NULL;
245 sysname(&tmp);
246 strcpy(name_c, tmp);
247 free(tmp);
248}
249
250int oct_number_of_lines(char * name_c) {
251
252 FILE *pf;
253 int c, i;
254
255 pf = fopen(name_c, "r");
256
257 if (pf != NULL) {
258 i = 0;
259 while ((c = getc(pf)) != EOF) {
260 if (c == '\n')
261 i++;
262 }
263 fclose(pf);
264 return i;
265 } else {
266 return -1;
267 }
268}
269
270/* Given a string in C, it breaks it line by line and returns each
271 as a Fortran string. Returns 0 if string does not have more lines.
272*/
273void FC_FUNC_(oct_break_c_string,
274 OCT_BREAK_C_STRING)(char **str, char **s,
275 char * line_f) {
276 char *c, line[256]; /* hopefully no line is longer than 256 characters ;) */
277
278 if (*s == NULL)
279 *s = *str;
280
281 if (*s == NULL || **s == '\0') {
282 *s = (char *)(0);
283 return;
284 }
285
286 for (c = line; **s != '\0' && **s != '\n'; (*s)++, c++)
287 *c = **s;
288 *c = '\0';
289 if (**s == '\n')
290 (*s)++;
291
292 strcpy(line_f, line);
293}
294
296
297This function searches in directory given by dirname all files that have the
298following name:
299
300*_<real_number>_<integer>*
301
302It returns the value of <real_number> found that is closest to freq (or
303abs(freq)) and for which the value of <integer> matches with the tag argument.
304
305The value found is returned in the freq argument.
306
307ierr results:
3080 : value found
3091 : no matching file found
3102 : cannot open the directory or function not available
311
312*/
313
314void oct_search_file_lr(double *freq, const fint *tag, fint *ierr,
315 char * name_c) {
316#ifdef _POSIX_VERSION
317
318 DIR *dir;
319 struct dirent *ent;
320 char *num_start, *num_end;
321 double read_value, min;
322 int found_something, read_tag;
323
324 dir = opendir(name_c);
325
326 if (dir == NULL) {
327 *ierr = 2;
328 return;
329 }
330
331 ent = NULL;
332 found_something = 0;
333
334 while (1) {
335 ent = readdir(dir);
336 if (ent == NULL)
337 break;
338
339 num_start = strchr(ent->d_name, '_');
340
341 if (num_start != NULL) {
342 num_start++; /* now this points to the beginning of the number */
343
344 /* take the numerical value from the string */
345 read_value = strtod(num_start, &num_end);
346
347 if (num_end == num_start)
348 continue; /* no number found */
349
350 /* check that we have the correct tag */
351 if (num_end[0] == '_') {
352
353 num_start = num_end + 1;
354 read_tag = (int)strtol(num_start, &num_end, 10);
355 if (num_end == num_start)
356 continue; /* no tag found */
357 if (read_tag != *tag)
358 continue; /* tag does not match */
359
360 } else
361 continue;
362
363 /* if this is the first number we found */
364 if (!found_something) {
365 min = read_value;
366 found_something = 1;
367 } else if (fabs(fabs(min) - fabs(*freq)) >
368 fabs(fabs(read_value) - fabs(*freq))) {
369 /* if the value is closer than previous */
370 min = read_value;
371 }
372 }
373 }
374
375 closedir(dir);
376
377 if (found_something) {
378 *ierr = 0;
379 *freq = min;
380 } else {
381 *ierr = 1;
382 }
383
384#else
385#warning directory search not compiled
386 fprintf(stderr, "Warning: Directory search not available since certain C "
387 "functions are not available.\n");
388 *ierr = 2;
389#endif
390}
391
392void *FC_FUNC_(oct_get_memory_usage, OCT_GET_MEMORY_USAGE)() {
393#ifdef _POSIX_VERSION
394 static size_t pagesize = 0;
395 FILE *f;
396 int pid;
397 unsigned long mem;
398 char s[256];
399
400 if (pagesize == 0)
401 pagesize = sysconf(_SC_PAGESIZE);
402
403 pid = getpid();
404 sprintf(s, "%s%d%s", "/proc/", pid, "/statm");
405 if ((f = fopen(s, "r")) == (FILE *)NULL)
406 return (void *)(-1);
407 fscanf(f, "%lu", &mem);
408 fclose(f);
409
410 return (void *)(mem * pagesize);
411#else
412 return 0;
413#endif
414}
415
416/* Get the path to the current executable. As there is no portable solution,
417 * we need a different implementation for Linux and Mac (and possible other OSs) */
418void oct_executable_path(char * path) {
419#if defined(__APPLE__) && defined(__MACH__)
420 char *buf = NULL;
421 uint32_t bufsize = 0;
422 int ret = 0;
423 ret = _NSGetExecutablePath(buf, &bufsize);
424 assert(ret == -1);
425 buf = (char *)malloc(bufsize);
426 assert(buf != NULL);
427 ret = _NSGetExecutablePath(buf, &bufsize);
428 assert(ret == 0);
429 path = realpath(buf, NULL);
430 free(buf);
431#elif defined(linux) || defined(__linux)
432 path = realpath("/proc/self/exe", NULL);
433#elif defined(__NETBSD__) || defined(__NetBSD__)
434 path = realpath("/proc/curproc/exe", NULL);
435#elif defined(__DragonFly__)
436 path = realpath("/proc/curproc/file", NULL);
437#elif defined(__FreeBSD__)
438 int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PATHNAME, -1};
439 size_t len = 0;
440 int ret = 0;
441 ret = sysctl(mib, 4, NULL, &len, NULL, 0);
442 assert(ret == 0);
443 path = malloc(len);
444 assert(path != NULL);
445 ret = sysctl(mib, 4, path, &len, NULL, 0);
446 assert(ret == 0);
447#else
448 /* if OS is not recognized, return empty string - in the calling code, this is then ignored */
449 path = (char *)malloc(1);
450 assert(path != NULL);
451 path[0] = '\0';
452#endif
453 if (path == NULL) {
454 fprintf(stderr, "%s:%d: in %s: Something went wrong\n", __FILE__, __LINE__, __func__);
455 path = (char *)malloc(1);
456 assert(path != NULL);
457 path[0] = '\0';
458 }
459 return;
460}
char * getcwd(char *__buf, size_t __size) __attribute__((__nothrow__
int fint
Definition: fortran_types.h:14
__uint32_t uint32_t
Definition: io_binary.c:1336
double fabs(double __x) __attribute__((__nothrow__
__time_t time_t
Definition: io_binary.c:286
double fn(const gsl_vector *v, void *params)
real(real64) function s()
struct __dirstream DIR
Definition: oct_f.c:4678
long int sysconf(int __name) __attribute__((__nothrow__
void oct_wfs_list(char *str_c, fint l[16384])
Definition: oct_f.c:5137
void oct_executable_path(char *path)
Definition: oct_f.c:5483
void oct_rm(char *name_c)
Definition: oct_f.c:5081
void oct_getcwd(char *name)
Definition: oct_f.c:5085
int mkdir(const char *__path, __mode_t __mode) __attribute__((__nothrow__
void oct_basename(char *fn, char *bn)
Definition: oct_f.c:5108
__pid_t getpid(void)
Definition: oct_f.c:4250
int gettimeofday(struct timeval *__restrict __tv, void *__restrict __tz) __attribute__((__nothrow__
void oct_sysname(char *name_c)
Definition: oct_f.c:5282
int oct_number_of_lines(char *name_c)
Definition: oct_f.c:5294
void oct_stat(fint *ierr, char *name_c, char *mod_time_c)
Definition: oct_f.c:5031
@ _SC_PAGESIZE
Definition: oct_f.c:3681
void oct_realpath(char *fn, char *rn)
Definition: oct_f.c:5089
void oct_dirname(char *fn, char *dn)
Definition: oct_f.c:5104
void oct_getenv(char *name_c, char *var_c)
Definition: oct_f.c:5116
void sysname(char **c)
Definition: varia.c:4623
DIR DIR struct dirent * readdir(DIR *__dirp) __attribute__((__nonnull__(1)))
DIR * opendir(const char *__name) __attribute__((__nonnull__(1))) __attribute__((__malloc__)) __attribute__((__malloc__(closedir
FILE * stderr
int closedir(DIR *__dirp) __attribute__((__nonnull__(1)))
int oct_dir_exists(char *name_c)
Definition: oct_f.c:5060
void FC_FUNC_(oct_progress_bar, OCT_PROGRESS_BAR)
Definition: oct_f.c:5231
int stat(const char *__restrict __file, struct stat *__restrict __buf) __attribute__((__nothrow__
int fclose(FILE *__stream)
clock_t clock(void)
Definition: oct_f.c:3240
void oct_search_file_lr(double *freq, const fint *tag, fint *ierr, char *name_c)
Definition: oct_f.c:5355
void progress_bar(int actual, int max)
Definition: varia.c:4741
void oct_mkdir(char *name_c)
Definition: oct_f.c:5013
ptrdiff_t l
Definition: operate_inc.c:12
ptrdiff_t i
Definition: operate_inc.c:12
static double f(double w, void *p)
__syscall_slong_t tv_nsec
Definition: getopt_f.c:1120
__time_t tv_sec
Definition: getopt_f.c:1115