TABLE OF CONTENTS


ABINIT/m_clib [ Modules ]

[ Top ] [ Modules ]

NAME

 m_clib

FUNCTION

COPYRIGHT

 Copyright (C) 2009-2022 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