TABLE OF CONTENTS
ABINIT/m_clib [ Modules ]
NAME
m_clib
FUNCTION
COPYRIGHT
Copyright (C) 2009-2024 ABINIT group (MG) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
SOURCE
15 #if defined HAVE_CONFIG_H 16 #include "config.h" 17 #endif 18 19 #include "abi_common.h" 20 21 MODULE m_clib 22 23 use, intrinsic :: iso_c_binding 24 25 implicit none 26 27 private 28 29 public :: clib_rename ! Rename a file with a new name using the rename function from C stdlib 30 public :: clib_cclock 31 public :: clib_etime 32 public :: clib_mtrace 33 public :: clib_print_mallinfo 34 public :: clib_ulimit_stack ! Set stack size limit to maximum allowed value. 35 public :: clib_getpid 36 !public :: clib_usleep ! Suspend calling thread for microseconds of clock time 37 38 39 !FIXME the interfaces below have been commented out since abilint 40 ! JB : because interface must have a name in abilint 41 42 ! =================================================== 43 ! ==== Fortran-bindings declared in fsi_posix.c ==== 44 ! =================================================== 45 ! interface 46 ! subroutine clib_mkdir(path, ierr) 47 ! import 48 ! character(len=*),intent(in) :: path 49 ! integer(c_int),intent(out) :: ierr 50 ! end subroutine clib_mkdir 51 ! end interface 52 ! 53 54 interface 55 integer(c_int) function c_rename(oldname, newname) bind(C, name='rename') 56 import 57 character(kind=c_char),intent(in) :: oldname(*) 58 character(kind=c_char),intent(in) :: newname(*) 59 end function c_rename 60 end interface 61 62 interface 63 subroutine clib_cclock(cpu) bind(C, name="cclock") 64 import 65 real(c_double),intent(out) :: cpu 66 end subroutine clib_cclock 67 end interface 68 69 interface 70 real(c_double) function clib_etime(tt) bind(C, name="etime") result(res) 71 import 72 real(c_float),intent(out) :: tt(2) 73 end function clib_etime 74 end interface 75 76 interface 77 ! pid_t getpid(). 78 ! The type of pid_t data is a signed integer type (signed int or we can say int). 79 function clib_getpid() bind(C, name='getpid') 80 import 81 integer(c_int) :: clib_getpid 82 end function clib_getpid 83 end interface 84 85 ! ================================================= 86 ! ==== Fortran-bindings declared in mallinfo.c ==== 87 ! ================================================= 88 interface 89 subroutine clib_mallinfo(arena, hblkhd, usmblks, fsmblks, uordblks, fordblks) bind(C, name="clib_mallinfo") 90 import 91 integer(c_long),intent(out) :: arena, hblkhd, usmblks, fsmblks, uordblks, fordblks 92 end subroutine clib_mallinfo 93 end interface 94 95 ! ================================================== 96 ! ==== Fortran-bindings declared in gnu_tools.c ==== 97 ! ================================================== 98 99 interface 100 subroutine clib_mtrace(ierr) bind(C, name="clib_mtrace") 101 import 102 integer(c_int),intent(out) :: ierr 103 end subroutine 104 end interface 105 106 interface 107 subroutine clib_muntrace(ierr) bind(C, name="clib_muntrace") 108 import 109 integer(c_int),intent(out) :: ierr 110 end subroutine 111 end interface 112 113 interface 114 subroutine clib_mcheck(ierr) bind(C, name="clib_mcheck") 115 import 116 integer(c_int),intent(out) :: ierr 117 end subroutine 118 end interface 119 120 interface 121 ! Set stack size limit to maximum allowed value. Return soft and hard limit and exit status. 122 subroutine clib_ulimit_stack(rlim_cur, rlim_max, ierr) bind(C, name="ulimit_stack") 123 import 124 integer(c_long),intent(out) :: rlim_cur, rlim_max 125 integer(c_int),intent(out) :: ierr 126 end subroutine 127 end interface 128 129 !interface 130 ! ! suspend calling thread for microseconds of clock time 131 ! ! uses unistd.h for Fortran standard compliant sleep. 132 ! ! sleep() is a GNU extension, not standard Fortran 133 ! subroutine usleep(us) bind(C) 134 ! import 135 ! integer(c_int), value :: us 136 ! end subroutine usleep 137 !end interface 138 139 !interface 140 ! ! int usleep(useconds_t useconds) 141 ! function clib_usleep(useconds) bind(c, name='usleep') 142 ! import 143 ! integer(kind=c_int32_t), value :: useconds 144 ! integer(kind=c_int) :: c_usleep 145 ! end function clib_usleep 146 !end interface 147 148 ! ========================================== 149 ! ==== Fortran-bindings for file_lock.c ==== 150 ! ========================================== 151 152 !interface 153 ! function lock_file(path) bind(C) 154 ! import 155 ! implicit none 156 ! character(kind=c_char),intent(in) :: path(*) 157 ! integer(c_int) :: lock_file 158 ! end function lock_file 159 !end interface 160 161 !interface 162 ! function unlock_fd(fd) bind(C) 163 ! import 164 ! implicit none 165 ! integer(c_int),value,intent(in) :: fd 166 ! integer(c_int) unlock_fd 167 ! end function unlock_fd 168 !end interface 169 170 171 contains
m_clib/clib_print_fmallinfo [ Functions ]
[ Top ] [ m_clib ] [ Functions ]
NAME
clib_print_fmallinfo
FUNCTION
INPUTS
OUTPUT
SOURCE
186 subroutine clib_print_mallinfo(unit) 187 188 !Arguments ------------------------------------ 189 integer,intent(in) :: unit 190 191 !Local variables------------------------------- 192 integer(c_long) :: arena,hblkhd,usmblks,fsmblks,uordblks,fordblks 193 ! ********************************************************************* 194 195 call clib_mallinfo(arena, hblkhd, usmblks, fsmblks, uordblks, fordblks) 196 197 write(unit,*)"" 198 write(unit,*)"--- !Mallinfo" 199 write(unit,*)' Total space in arena: ',arena 200 write(unit,*)' Space in holding block headers: ',hblkhd 201 write(unit,*)' Space in small blocks in use: ',usmblks 202 write(unit,*)' Space in free small blocks: ',fsmblks 203 write(unit,*)' Space in ordinary blocks in use: ',uordblks 204 write(unit,*)' Space in free ordinary blocks: ',fordblks 205 write(unit,*)"..." 206 write(unit,*)"" 207 208 end subroutine clib_print_mallinfo
m_clib/clib_rename [ Functions ]
[ Top ] [ m_clib ] [ Functions ]
NAME
clib_rename
FUNCTION
Rename a file with a new name using the rename function from C stdlib
INPUTS
OUTPUT
SOURCE
224 integer function clib_rename(old_fname, new_fname) result(ierr) 225 226 !Arguments ------------------------------------ 227 character(len=*),intent(in) :: old_fname, new_fname 228 229 ! ********************************************************************* 230 231 ierr = c_rename(trim(old_fname)//c_null_char, trim(new_fname)//c_null_char) 232 233 end function clib_rename