Ignore:
Timestamp:
Oct 12, 2023, 10:30:22 AM (15 months ago)
Author:
slebonnois
Message:

BBT : Update for the titan microphysics and cloud model

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.TITAN/libf/muphytitan/fsystem.F90

    r1897 r3083  
    1 ! Copyright Jérémie Burgalat (2010-2015,2017)
    2 !
    3 ! jeremie.burgalat@univ-reims.fr
    4 !
    5 ! This software is a computer program whose purpose is to provide configuration
    6 ! file and command line arguments parsing features to Fortran programs.
    7 !
    8 ! This software is governed by the CeCILL-B license under French law and
    9 ! abiding by the rules of distribution of free software.  You can  use,
    10 ! modify and/ or redistribute the software under the terms of the CeCILL-B
    11 ! license as circulated by CEA, CNRS and INRIA at the following URL
    12 ! "http://www.cecill.info".
    13 !
    14 ! As a counterpart to the access to the source code and  rights to copy,
    15 ! modify and redistribute granted by the license, users are provided only
    16 ! with a limited warranty  and the software's author,  the holder of the
    17 ! economic rights,  and the successive licensors  have only  limited
    18 ! liability.
    19 !
    20 ! In this respect, the user's attention is drawn to the risks associated
    21 ! with loading,  using,  modifying and/or developing or reproducing the
    22 ! software by the user in light of its specific status of free software,
    23 ! that may mean  that it is complicated to manipulate,  and  that  also
    24 ! therefore means  that it is reserved for developers  and  experienced
    25 ! professionals having in-depth computer knowledge. Users are therefore
    26 ! encouraged to load and test the software's suitability as regards their
    27 ! requirements in conditions enabling the security of their systems and/or
    28 ! data to be ensured and,  more generally, to use and operate it in the
    29 ! same conditions as regards security.
    30 !
    31 ! The fact that you are presently reading this means that you have had
    32 ! knowledge of the CeCILL-B license and that you accept its terms.
     1! Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
     2!
     3! This file is part of SWIFT
     4!
     5! Permission is hereby granted, free of charge, to any person obtaining a copy of
     6! this software and associated documentation files (the "Software"), to deal in
     7! the Software without restriction, including without limitation the rights to
     8! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
     9! the Software, and to permit persons to whom the Software is furnished to do so,
     10! subject to the following conditions:
     11!
     12! The above copyright notice and this permission notice shall be included in all
     13! copies or substantial portions of the Software.
     14!
     15! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
     16! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
     17! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
     18! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
     19! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
     20! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    3321
    3422!! file: fsystem.F90
    3523!! summary: File system methods source file.
    3624!! author: J. Burgalat
    37 !! date: 2013-2015,2017
     25!! date: 2013-2015,2017,2022
    3826
    3927
    … …  
    4634  IMPLICIT NONE
    4735
    48   PUBLIC 
     36  PUBLIC
    4937
    5038  PRIVATE :: get_umask
    … …  
    5745    !!
    5846    !! This object can be used to get an approximation of the execution of some piece of code.
    59     REAL(kind=8), PRIVATE    :: cpu_start = 0d0   
     47    REAL(kind=8), PRIVATE    :: cpu_start = 0d0
    6048      !! Starting CPU time
    61     INTEGER(kind=8), PRIVATE :: clock_start = 0d0 
     49    INTEGER(kind=8), PRIVATE :: clock_start = 0d0
    6250      !! Starting clock time
    6351    LOGICAL, PRIVATE         :: on_run = .false.
    6452      !! Chrono running state.
    6553#if HAVE_FTNPROC
    66     CONTAINS 
    67       PROCEDURE :: is_running => chrono_is_running 
     54    CONTAINS
     55      PROCEDURE :: is_running => chrono_is_running
    6856      PROCEDURE :: start      => chrono_start
    6957      PROCEDURE :: stop       => chrono_stop
    … …  
    9583    END FUNCTION errno_c
    9684
    97     FUNCTION usleep_c(usec) BIND(C,name="usleep") 
     85    FUNCTION usleep_c(usec) BIND(C,name="usleep")
    9886      !! (attemps to) Sleep for a given number of microseconds
    9987      IMPORT C_INT
    … …  
    127115
    128116    FUNCTION access_c(path,perm) BIND(C,name="c_access")
    129       !! Check if path is accessible for current user 
     117      !! Check if path is accessible for current user
    130118      IMPORT c_char, C_INT
    131119      CHARACTER(len=c_char), INTENT(in)      :: path(*)  !! Path to check
    … …  
    134122    END FUNCTION access_c
    135123
    136     FUNCTION create_c(path,mode,asfile,forced) BIND(C,name="c_create") 
     124    FUNCTION create_c(path,mode,asfile,forced) BIND(C,name="c_create")
    137125      !! Create a directory or a file in given path
    138126      IMPORT c_char, C_INT
    … …  
    149137      INTEGER(kind=C_INT), INTENT(in), VALUE :: uid     !! User id
    150138      TYPE(C_PTR)                            :: uname_c !! C_PTR to the underlying char* pointer storing user name
    151     END FUNCTION uname_c 
     139    END FUNCTION uname_c
    152140
    153141    FUNCTION gname_c(gid) BIND(C, name="c_gname")
    … …  
    156144      INTEGER(kind=C_INT), INTENT(in), VALUE :: gid     !! Group id
    157145      TYPE(C_PTR)                            :: gname_c !! C_PTR to the underlying char* pointer storing group name
    158     END FUNCTION gname_c 
    159 
    160     FUNCTION dirname_c(path) BIND(C,name="c_dirname") 
     146    END FUNCTION gname_c
     147
     148    FUNCTION dirname_c(path) BIND(C,name="c_dirname")
    161149      !! Get the directory name of the path
    162150      IMPORT c_char, c_ptr
    … …  
    172160    END FUNCTION basename_c
    173161
    174     FUNCTION getcwd_c() BIND(C,name="c_getcwd") 
     162    FUNCTION getcwd_c() BIND(C,name="c_getcwd")
    175163      !! Get the current working directory
    176164      IMPORT c_ptr
    … …  
    198186      CHARACTER(kind=c_char), INTENT(in) :: input(*)  !! Path to rename
    199187      CHARACTER(kind=c_char), INTENT(in) :: output(*) !! New name of the path
    200       INTEGER(kind=C_INT)                :: rename_c  !! 0 on success, last errno on failure 
     188      INTEGER(kind=C_INT)                :: rename_c  !! 0 on success, last errno on failure
    201189    END FUNCTION rename_c
    202190
    … …  
    206194      CHARACTER(kind=c_char), INTENT(in)     :: path(*) !! Path to modify
    207195      INTEGER(kind=C_INT), INTENT(in), VALUE :: mode    !! New decimal permissions of the path to set
    208       INTEGER(kind=C_INT)                    :: chmod_c !! 0 on success, last errno on failure 
     196      INTEGER(kind=C_INT)                    :: chmod_c !! 0 on success, last errno on failure
    209197    END FUNCTION chmod_c
    210198
    … …  
    213201      IMPORT c_char, C_INT
    214202      CHARACTER(kind=c_char), INTENT(in)  :: new(*)  !! Path of the new working directory
    215       INTEGER(kind=C_INT)                 :: chdir_c !! 0 on success, last errno on failure 
     203      INTEGER(kind=C_INT)                 :: chdir_c !! 0 on success, last errno on failure
    216204    END FUNCTION chdir_c
    217205
    … …  
    220208      IMPORT c_char, C_INT
    221209      CHARACTER(kind=c_char), INTENT(in)     :: dirname(*) !! Path of the directory to create
    222       INTEGER(kind=C_INT), INTENT(in), VALUE :: mode       !! Decimal permission to set 
    223       INTEGER(kind=C_INT)                    :: mkdir_c    !! 0 on success, last errno on failure 
     210      INTEGER(kind=C_INT), INTENT(in), VALUE :: mode       !! Decimal permission to set
     211      INTEGER(kind=C_INT)                    :: mkdir_c    !! 0 on success, last errno on failure
    224212    END FUNCTION mkdir_c
    225213
    … …  
    228216      IMPORT c_char, C_INT
    229217      CHARACTER(kind=c_char), INTENT(in)     :: dirname(*) !! Path of the directory to create
    230       INTEGER(kind=C_INT), INTENT(in), VALUE :: mode       !! Decimal permission to set 
    231       INTEGER(kind=C_INT)                    :: mkdirp_c   !! 0 on success, last errno on failure 
     218      INTEGER(kind=C_INT), INTENT(in), VALUE :: mode       !! Decimal permission to set
     219      INTEGER(kind=C_INT)                    :: mkdirp_c   !! 0 on success, last errno on failure
    232220    END FUNCTION mkdirp_c
    233221
    234     FUNCTION copy_c(to,from) BIND(C,name="c_copy") 
     222    FUNCTION copy_c(to,from) BIND(C,name="c_copy")
    235223      !! Copy a file.
    236224      IMPORT c_char, C_INT
    … …  
    240228    END FUNCTION copy_c
    241229
    242     FUNCTION remove_c(path) BIND(C,name="c_remove") 
     230    FUNCTION remove_c(path) BIND(C,name="c_remove")
    243231      !! Remove a file (or a directory) from the filesystem
    244232      IMPORT c_char, C_INT
    245233      CHARACTER(kind=c_char), INTENT(in)  :: path(*)  !! Path to delete
    246       INTEGER(kind=C_INT)                 :: remove_c !! 0 on success, last errno on failure 
     234      INTEGER(kind=C_INT)                 :: remove_c !! 0 on success, last errno on failure
    247235    END FUNCTION remove_c
    248236
    … …  
    251239      IMPORT c_char, C_INT
    252240      CHARACTER(kind=c_char), INTENT(in) :: dirpath(*) !! Directory to delete
    253       INTEGER(kind=C_INT)                :: rmdir_c    !! 0 on success, last errno on failure 
     241      INTEGER(kind=C_INT)                :: rmdir_c    !! 0 on success, last errno on failure
    254242    END FUNCTION rmdir_c
    255243
    … …  
    258246      IMPORT c_char, C_INT
    259247      CHARACTER(kind=c_char), INTENT(in) :: dirpath(*) !! Directory to delete
    260       INTEGER(kind=C_INT)                :: rmdirf_c   !! 0 on success, last errno on failure 
     248      INTEGER(kind=C_INT)                :: rmdirf_c   !! 0 on success, last errno on failure
    261249    END FUNCTION rmdirf_c
    262250
    … …  
    282270      INTEGER(kind=C_INT), INTENT(out) :: r, &       !! Number of rows
    283271                                          c          !! Number of columns
    284       INTEGER(kind=C_INT)              :: termsize_c !! 0 on success, last errno on failure 
     272      INTEGER(kind=C_INT)              :: termsize_c !! 0 on success, last errno on failure
    285273    END FUNCTION termsize_c
    286274
    … …  
    289277      IMPORT  C_SIZE_T
    290278      INTEGER(kind=C_SIZE_T) :: getCurrentRSS_c !! Current resident set size in bytes (0 if not available).
    291     END FUNCTION getCurrentRSS_c 
     279    END FUNCTION getCurrentRSS_c
    292280
    293281    FUNCTION getPeakRSS_c() BIND(C, name="c_getPeakRSS")
    … …  
    295283      IMPORT  C_SIZE_T
    296284      INTEGER(kind=C_SIZE_T) :: getPeakRSS_c !! Peak resident set size in bytes (0 if not available).
    297     END FUNCTION getPeakRSS_c 
     285    END FUNCTION getPeakRSS_c
    298286
    299287    FUNCTION getSystemMemory_c(total,avail,free) BIND(C, name='c_getSystemMemory')
    … …  
    303291      INTEGER(kind=C_LONG_LONG), INTENT(out) :: avail             !! Current available memory.
    304292      INTEGER(kind=C_LONG_LONG), INTENT(out) :: free              !! Current free memory.
    305       INTEGER(kind=C_INT)                    :: getSystemMemory_c !! status, 0 on success, 1 otherwise. 
     293      INTEGER(kind=C_INT)                    :: getSystemMemory_c !! status, 0 on success, 1 otherwise.
    306294    END FUNCTION getSystemMemory_c
    307295  END INTERFACE
    … …  
    311299
    312300  FUNCTION fstring(string) RESULT(str)
    313     !! Convert C string to  Fortran string 
     301    !! Convert C string to  Fortran string
    314302    !!
    315303    !! The method copies the input C string up to the last C_NULL_CHAR found (not including it),
    316304    !! and returns the converted Fortran string.
    317305    !! All other C_NULL_CHAR found in the C string are removed.
    318     CHARACTER(len=*), INTENT(in) :: string !! A string from C 
     306    CHARACTER(len=*), INTENT(in) :: string !! A string from C
    319307    CHARACTER(len=:), ALLOCATABLE :: str   !! Converted fortran string
    320     INTEGER :: i,idx 
     308    INTEGER :: i,idx
    321309    str = ""
    322310    idx = INDEX(string,C_NULL_CHAR,.true.)
    … …  
    335323    !!
    336324    !! The method build the fortran string from a TYPE(C_PTR) object that represent a
    337     !! C char\* pointer string. 
     325    !! C char\* pointer string.
    338326    !! @note
    339327    !! If __cstr__ is not allocated (i.e. the C_PTR is not associated) or if it is set
    340328    !! to a C empty string (i.e. '\0') then the method returns an empty string.
    341329    !! @attention
    342     !! The method does not free the underlying C string and it should be free using 
     330    !! The method does not free the underlying C string and it should be free using
    343331    !! the subroutine free_c(_cstr_).
    344332    TYPE(C_PTR), INTENT(in) :: cstr
    … …  
    366354
    367355  FUNCTION cstring(string) RESULT(str)
    368     !> convert Fortran string to cstring 
     356    !> convert Fortran string to cstring
    369357    !!
    370358    !! The method returns a copy of the input string suitable for C functions argument.
    371     !! @note 
     359    !! @note
    372360    !! Input string is trimmed during computations
    373361    CHARACTER(len=*), INTENT(in) :: string
    … …  
    385373!===============================================================================
    386374
    387   FUNCTION fs_getgid() RESULT(ret) 
     375  FUNCTION fs_getgid() RESULT(ret)
    388376    !! Get Group ID
    389377    INTEGER(kind=4) :: ret !! An integer with the group identifier
    390     ret = INT(getgid_c(),kind=4) 
     378    ret = INT(getgid_c(),kind=4)
    391379    RETURN
    392380  END FUNCTION fs_getgid
    … …  
    399387  END FUNCTION fs_getpid
    400388
    401   FUNCTION fs_getuid() RESULT(ret) 
     389  FUNCTION fs_getuid() RESULT(ret)
    402390    !! Get User ID
    403391    INTEGER(kind=4) :: ret !! An integer with the user identifier
    … …  
    413401    zname = gname_c(gid)
    414402    IF (.NOT.C_ASSOCIATED(zname)) THEN
    415       gname = "" 
     403      gname = ""
    416404    ELSE
    417405      gname = cstr2fstr(zname)
    … …  
    427415    zname = gname_c(uid)
    428416    IF (.NOT.C_ASSOCIATED(zname)) THEN
    429       uname = "" 
     417      uname = ""
    430418    ELSE
    431419      uname = cstr2fstr(zname)
    … …  
    438426    CHARACTER(len=*), INTENT(in)  :: path
    439427      !! A string with a (valid) path
    440     CHARACTER(len=:), ALLOCATABLE :: opath 
     428    CHARACTER(len=:), ALLOCATABLE :: opath
    441429      !! A Fortran allocated string with the parent directory path or an empty string if method fails
    442430    TYPE(C_PTR) :: zpath
    … …  
    458446    CHARACTER(len=*), INTENT(in)  :: path
    459447      !! A string with a (valid) path
    460     CHARACTER(len=:), ALLOCATABLE :: opath 
     448    CHARACTER(len=:), ALLOCATABLE :: opath
    461449      !! The basename of the path or an empty string if method fails
    462450    TYPE(C_PTR) :: zpath
    … …  
    478466    !!
    479467    !! The method computes the absolute path of the given path using C realpath function.
    480     !! @note 
     468    !! @note
    481469    !! If the input path is empty then current working directory is returned.
    482470    CHARACTER(len=*), INTENT(in)  :: path
    483471      !! A string with a (valid) path
    484     CHARACTER(len=:), ALLOCATABLE :: opath 
     472    CHARACTER(len=:), ALLOCATABLE :: opath
    485473      !! The absolute of the path or an empty string if method fails
    486474    TYPE(C_PTR) :: zpath
    … …  
    497485    !! Get the relative representation of two paths
    498486    !!
    499     !! The method computes the relative representation of __path__ from __reldir__ if possible. 
     487    !! The method computes the relative representation of __path__ from __reldir__ if possible.
    500488    !! If no common prefix is found, the method returns __path__.
    501489    CHARACTER(len=*), INTENT(in) :: path, & !! Path to be computed relative to reldir
    … …  
    508496    ELSE
    509497      res = cstr2fstr(zpath)
    510     ENDIF 
     498    ENDIF
    511499    CALL free_c(zpath)
    512500  END FUNCTION fs_relpath
    513501
    514   FUNCTION fs_getcwd() RESULT(path) 
     502  FUNCTION fs_getcwd() RESULT(path)
    515503    !! Get the current working directory
    516504    CHARACTER(len=:), ALLOCATABLE :: path
    … …  
    558546    LOGICAL :: ret                         !! True on success, false otherwise.
    559547    IF (LEN_TRIM(old) == 0.OR.LEN_TRIM(new) == 0) THEN
    560       ret = .false. 
     548      ret = .false.
    561549    ELSE
    562550      ret = INT(rename_c(cstring(ADJUSTL(old)),cstring(ADJUSTL(new)))) == 0
    … …  
    572560    INTEGER(kind=C_INT) :: zmode
    573561    IF (LEN_TRIM(path) == 0) THEN
    574       ret = .false. 
     562      ret = .false.
    575563    ELSE
    576564      zmode = INT(oct_2_dec(mode),kind=C_INT)
    … …  
    585573    LOGICAL :: ret                       !! True on success, false otherwise.
    586574    IF (LEN_TRIM(path) == 0) THEN
    587       ret = .false. 
     575      ret = .false.
    588576    ELSE
    589577      ret = INT(chdir_c(cstring(ADJUSTL(path)))) == 0
    … …  
    597585    !! The method attempts to create a new directory pointed by __path__ with the permission
    598586    !! given by mode.
    599     CHARACTER(len=*), INTENT(in)  :: path 
     587    CHARACTER(len=*), INTENT(in)  :: path
    600588      !! The path to modify
    601589    INTEGER, INTENT(in), OPTIONAL :: mode
    … …  
    608596    LOGICAL :: zperm
    609597    IF (LEN_TRIM(path) == 0) THEN
    610       ret = .false. 
    611     ELSE
    612       zmode = oct_2_dec(744) 
     598      ret = .false.
     599    ELSE
     600      zmode = oct_2_dec(744)
    613601      IF (PRESENT(mode)) THEN
    614         IF (.NOT.chk_pm(mode)) THEN 
     602        IF (.NOT.chk_pm(mode)) THEN
    615603          ret = .false. ; RETURN
    616604        ENDIF
    617605        zmode = oct_2_dec(mode)
    618606      ENDIF
    619       zperm = .false. ; IF (PRESENT(permissive)) zperm = permissive 
     607      zperm = .false. ; IF (PRESENT(permissive)) zperm = permissive
    620608      IF (zperm) THEN
    621609        ret = INT(mkdirp_c(cstring(ADJUSTL(path)),INT(zmode,kind=C_INT))) == 0
    … …  
    630618    !! Remove directory
    631619    !!
    632     !! By default, the function removes an __empty__ directory. If __forced__ is given and set 
     620    !! By default, the function removes an __empty__ directory. If __forced__ is given and set
    633621    !! to .true. then the function recursively deletes the directory and __ALL__ its content.
    634622    CHARACTER(len=*), INTENT(in)  :: path
    … …  
    638626    LOGICAL :: ret
    639627      !! True on success, false otherwise.
    640     LOGICAL :: zforce 
     628    LOGICAL :: zforce
    641629    IF (LEN_TRIM(path) == 0) THEN
    642       ret = .false. 
     630      ret = .false.
    643631    ELSE
    644632      zforce = .false. ; IF (PRESENT(forced)) zforce = forced
    … …  
    655643    !! Get some informations about a path
    656644    !!
    657     !! The method retrieves various informations about the input path using fstat C function. 
     645    !! The method retrieves various informations about the input path using fstat C function.
    658646    !! The type of path as returned in __type__ argument is can take the following values:
    659647    !!
    … …  
    666654    INTEGER, INTENT(out), OPTIONAL           :: type,  & !! Optional type of path (see function documentation).
    667655                                                perm,  & !! Optional permission of the path
    668                                                 nlnks, & !! Optional number of links to the path 
     656                                                nlnks, & !! Optional number of links to the path
    669657                                                uid,   & !! Optional user id
    670658                                                gid      !! Optional group id
    … …  
    674662                                                ctime    !! Optional creation time
    675663    LOGICAL :: ret                                       !! True on success, false otherwise.
    676     INTEGER                       :: ty,pe,ln,ud,gd 
     664    INTEGER                       :: ty,pe,ln,ud,gd
    677665    INTEGER(kind=8)               :: fs
    678666    CHARACTER(len=:), ALLOCATABLE :: at,mt,ct
    … …  
    691679      ret = INT(fstat_c(cstring(ADJUSTL(path)),p,l,t,u,g,f,ta,tm,tc)) == 0
    692680      IF (ret) THEN
    693         pe=INT(p) ; ln=INT(l) ; ty=INT(t) ; ud=INT(u) ; gd=INT(g) 
    694         fs=INT(f,kind=8) 
     681        pe=INT(p) ; ln=INT(l) ; ty=INT(t) ; ud=INT(u) ; gd=INT(g)
     682        fs=INT(f,kind=8)
    695683        at = fstring(ta)
    696684        mt = fstring(tm)
    697685        ct = fstring(tc)
    698686      ENDIF
    699       IF (PRESENT(type))  type  = ty 
     687      IF (PRESENT(type))  type  = ty
    700688      IF (PRESENT(perm))  perm  = pe
    701689      IF (PRESENT(nlnks)) nlnks = ln
    … …  
    713701    !! Check if a path is a directory
    714702    !!
    715     !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific 
     703    !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
    716704    !! information about __path__ type.
    717705    CHARACTER(len=*), INTENT(in) :: path !! The path to check
    718     LOGICAL :: ret                       !! .true. if the path is a directory, .false. otherwise. 
     706    LOGICAL :: ret                       !! .true. if the path is a directory, .false. otherwise.
    719707    INTEGER :: ty
    720708    ret = fs_stat(path,type=ty)
    721     ret = ret.AND.(ty==2.or.ty==3) 
     709    ret = ret.AND.(ty==2.or.ty==3)
    722710    RETURN
    723711  END FUNCTION fs_isdir
    724712
    725713  FUNCTION fs_isfile(path) RESULT (ret)
    726     !! Check if a path is a file 
    727     !!
    728     !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific 
     714    !! Check if a path is a file
     715    !!
     716    !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
    729717    !! information about __path__ type.
    730718    CHARACTER(len=*), INTENT(in) :: path !! The path to check
    731     LOGICAL :: ret                       !! .true. if the path is a file, .false. otherwise. 
     719    LOGICAL :: ret                       !! .true. if the path is a file, .false. otherwise.
    732720    INTEGER :: ty
    733721    ret=fs_stat(path,type=ty)
    … …  
    737725
    738726  FUNCTION fs_islink(path) RESULT (ret)
    739     !! Check if a path is a link 
    740     !!
    741     !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific 
     727    !! Check if a path is a link
     728    !!
     729    !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
    742730    !! information about __path__ type.
    743731    CHARACTER(len=*), INTENT(in) :: path !! The path to check
    744     LOGICAL :: ret                       !! .true. if the path is a link, .false. otherwise. 
    745     INTEGER :: ty 
     732    LOGICAL :: ret                       !! .true. if the path is a link, .false. otherwise.
     733    INTEGER :: ty
    746734    ret=fs_stat(path,type=ty)
    747735    ret = ret.and.(ty==1.or.ty==3)
    … …  
    759747    !! - 1 : Checks for EXECUTE permission
    760748    !! - 2 : Checks for WRITE permission
    761     !! - 4 : Checks for READ permission 
     749    !! - 4 : Checks for READ permission
    762750    CHARACTER(len=*), INTENT(in)  :: path       !! Path to check
    763751    INTEGER, INTENT(in), OPTIONAL :: permission !! Optional permission to check
    … …  
    765753    INTEGER(kind=C_INT) :: zp
    766754    IF (LEN_TRIM(path) == 0) THEN
    767       ret = .false. 
     755      ret = .false.
    768756    ELSE
    769757      zp = 0 ; IF (PRESENT(permission)) zp = INT(permission,kind=C_INT)
    … …  
    777765    !! Split given path into base,extension
    778766    !!
    779     !! The __base__ of a path is conventionnally defined as all characters before the last dot of the path. 
    780     !! The extension (__ext__) of the path gathers consequently all characters from the last dot to the end 
     767    !! The __base__ of a path is conventionnally defined as all characters before the last dot of the path.
     768    !! The extension (__ext__) of the path gathers consequently all characters from the last dot to the end
    781769    !! of the string.
    782770    !! @note
    783     !! If the basename of the path begins by a dot then the path is assumed to be an hidden file (directory). 
     771    !! If the basename of the path begins by a dot then the path is assumed to be an hidden file (directory).
    784772    !! __ext__ will then be empty.
    785     CHARACTER(len=*), INTENT(in)               :: path     !! Path to split 
     773    CHARACTER(len=*), INTENT(in)               :: path     !! Path to split
    786774    CHARACTER(len=:), INTENT(out), ALLOCATABLE :: base, &  !! Output base of the path
    787775                                                  ext      !! Output extension of the path
    788     LOGICAL, INTENT(in), OPTIONAL              :: absolute !! .true. to return absolute path 
    789     LOGICAL                       :: ret                   !! .true. on success, .false. otherwise. 
     776    LOGICAL, INTENT(in), OPTIONAL              :: absolute !! .true. to return absolute path
     777    LOGICAL                       :: ret                   !! .true. on success, .false. otherwise.
    790778    LOGICAL                       :: zabs
    791779    INTEGER                       :: p
    792780    CHARACTER(len=:), ALLOCATABLE :: d,b,apath
    793     base = "" ; ext = "" 
     781    base = "" ; ext = ""
    794782    ret = .false.
    795783    IF (LEN_TRIM(path) == 0) THEN
    … …  
    800788    IF (zabs) THEN
    801789      apath = fs_realpath(path) ; IF (LEN_TRIM(apath) == 0) RETURN
    802     ENDIF 
     790    ENDIF
    803791    d = fs_dirname(apath) ; IF (LEN_TRIM(d) == 0) RETURN
    804792    b = fs_basename(apath) ; IF (LEN_TRIM(b) == 0) RETURN
    … …  
    806794    ! If dot is set as first char of basename : it's an hidden file
    807795    IF (p > 1) THEN
    808       ext = b(p:) ; base = TRIM(d)//"/"//b(:p-1) 
    809     ELSE
    810       base = TRIM(apath) 
     796      ext = b(p:) ; base = TRIM(d)//"/"//b(:p-1)
     797    ELSE
     798      base = TRIM(apath)
    811799    ENDIF
    812800    ret = .true.
    … …  
    815803
    816804  FUNCTION fs_create(path, mode, type, permissive) RESULT(ret)
    817     !! Create a directory/file 
     805    !! Create a directory/file
    818806    !!
    819807    !! The method creates the file/directory pointed by given __path__.
    … …  
    827815    !! Unless __permissive__ is set to .true., the method will fails if intermediate
    828816    !! directories in the path do not exist.
    829     CHARACTER(len=*), INTENT(in)           :: path        !! Path to create 
     817    CHARACTER(len=*), INTENT(in)           :: path        !! Path to create
    830818    INTEGER, INTENT(in), OPTIONAL          :: mode        !! Optional octal permisions to set
    831819    CHARACTER(len=1), INTENT(in), OPTIONAL :: type        !! Optional type of path to create
    … …  
    833821    LOGICAL :: ret                                        !! True on success, false otherwise.
    834822    INTEGER                       :: zmd,zt,zp
    835     CHARACTER(len=:), ALLOCATABLE :: b,e 
     823    CHARACTER(len=:), ALLOCATABLE :: b,e
    836824    ret = .false.
    837825    ! Checking for existence
    … …  
    839827      RETURN
    840828    ELSE IF (fs_access(path)) THEN
    841       RETURN 
     829      RETURN
    842830    ENDIF
    843831    ! Set type of path
    844832    IF (PRESENT(type)) THEN
    845833      IF (.NOT.(type(1:1)=="f".OR.type(1:1)=="d")) THEN
    846         RETURN 
     834        RETURN
    847835      ELSE
    848836        zt=0 ; IF (type(1:1)=="f") zt = 1
    … …  
    854842    ! set permissions according to type
    855843    IF (zt == 0) THEN
    856       zmd = oct_2_dec(777)-get_umask() 
     844      zmd = oct_2_dec(777)-get_umask()
    857845    ELSE
    858846      zmd = oct_2_dec(666) -get_umask()
    … …  
    874862  FUNCTION fs_get_parent(path, n) RESULT(opath)
    875863    !! Get the nth parent of the given path
    876     !! 
    877     !! The method first resolves the given path using [[fsystem(module):fs_realpath(function)]] 
     864    !!
     865    !! The method first resolves the given path using [[fsystem(module):fs_realpath(function)]]
    878866    !! to get an absolute path.
    879     !! @note 
     867    !! @note
    880868    !! If __n__ is greater than the maximum parent level of the path, "/" is returned.
    881869    CHARACTER(len=*), INTENT(in)  :: path
    882870      !! Input path
    883     INTEGER, INTENT(in), OPTIONAL :: n 
     871    INTEGER, INTENT(in), OPTIONAL :: n
    884872      !! The level of the parent to get
    885873    CHARACTER(len=:), ALLOCATABLE :: opath
    886       !! The nth parent of the given path, or an empty string if the parent can not be computed 
     874      !! The nth parent of the given path, or an empty string if the parent can not be computed
    887875    CHARACTER(len=:), ALLOCATABLE :: zp
    888876    INTEGER                       :: i,mx,zl,mzl
    889     opath = "" 
     877    opath = ""
    890878    zl = 1 ; IF (PRESENT(n)) zl = MAX(n,1)
    891879    IF (LEN_TRIM(path) == 0) THEN
    … …  
    900888    mzl = 1 ; DO i=1,mx ; IF(zp(i:i) == '/') mzl=mzl+1 ; ENDDO
    901889    i=0
    902     DO 
     890    DO
    903891      mx = INDEX(zp(1:mx),'/',.true.) ; i=i+1
    904       IF (mx==0.OR.i>=zl.OR.i>=mzl) EXIT 
     892      IF (mx==0.OR.i>=zl.OR.i>=mzl) EXIT
    905893      mx = mx - 1
    906894    ENDDO
    907895    IF (mx >= 1) THEN
    908896      opath = zp(1:MAX(1,mx-1))
    909     ELSE 
    910       opath = "/" 
     897    ELSE
     898      opath = "/"
    911899    ENDIF
    912900    RETURN
    … …  
    929917  SUBROUTINE fs_usleep(usec)
    930918    !! Sleep for a given number of microseconds
    931     !! @note 
    932     !! Currently if C usleep function failed, the system... does not sleep ! 
     919    !! @note
     920    !! Currently if C usleep function failed, the system... does not sleep !
    933921    INTEGER, INTENT(in) :: usec !! The number of microseconds to sleep for
    934     INTEGER(kind=C_INT) :: ret 
     922    INTEGER(kind=C_INT) :: ret
    935923    ! usleep expects useconds_t (unsigned int) which is given here as a 4-bytes int
    936924    ret = usleep_c(INT(usec,kind=C_INT))
    … …  
    979967    LOGICAL          :: zpeak
    980968    CHARACTER(len=2) :: zunits
    981     INTEGER(kind=8)  :: ztot,zava,zfre   
     969    INTEGER(kind=8)  :: ztot,zava,zfre
    982970
    983971    zunits = 'B '   ; IF (PRESENT(units)) zunits = units
    984972    IF (zunits /= 'B' .AND. zunits /= 'KB' .AND. zunits /= 'MB' .AND. zunits /= 'GB') zunits = 'B '
    985973    ret = INT(getSystemMemory_c(ztot,zava,zfre),kind=4) == 0
    986     ztot = ztot * 1024 ; zava = zava * 1024 ; zfre = zfre * 1024 
     974    ztot = ztot * 1024 ; zava = zava * 1024 ; zfre = zfre * 1024
    987975
    988976    IF (PRESENT(total))     total     = ztot
    … …  
    10141002  FUNCTION oct_2_dec(octal) RESULT(res)
    10151003    !> Octal to decimal conversion
    1016     !! 
     1004    !!
    10171005    !! The method converts the octal number ranging from 0 to 777 in the decimal system.
    10181006    !! @attention
    … …  
    10291017    ENDDO
    10301018    res=d
    1031     RETURN 
     1019    RETURN
    10321020  END FUNCTION oct_2_dec
    10331021
    … …  
    10591047    !! Get octal number of string representation's permission
    10601048    CHARACTER(len=3),INTENT(in) :: str !! The permission to convert
    1061     INTEGER :: oct                     !! Octal value of the string permission on succes, -1 otherwise. 
     1049    INTEGER :: oct                     !! Octal value of the string permission on succes, -1 otherwise.
    10621050    oct = -1
    10631051    IF (LEN_TRIM(str) /= 3) RETURN
    10641052    SELECT CASE(str)
    1065       CASE("---")  ; oct = 0 
     1053      CASE("---")  ; oct = 0
    10661054      CASE("--x")  ; oct = 1
    10671055      CASE("-w-")  ; oct = 2
    … …  
    10711059      CASE("rw-")  ; oct = 6
    10721060      CASE("rwx")  ; oct = 7
    1073       CASE DEFAULT 
     1061      CASE DEFAULT
    10741062        oct = -1 ; RETURN
    1075     END SELECT 
     1063    END SELECT
    10761064    RETURN
    10771065  END FUNCTION sp_2_op
    … …  
    10901078      CASE(6) ; str="rw-"
    10911079      CASE(7) ; str="rwx"
    1092       CASE DEFAULT 
     1080      CASE DEFAULT
    10931081        str='ukn' ; RETURN
    1094     END SELECT 
     1082    END SELECT
    10951083    RETURN
    10961084  END FUNCTION op_2_sp
    … …  
    10981086  FUNCTION str_perm(oct_perm) RESULT(ret)
    10991087    !! Get the string representation of the given permission mask
    1100     INTEGER, INTENT(in) :: oct_perm !! The octal representation of the permission 
     1088    INTEGER, INTENT(in) :: oct_perm !! The octal representation of the permission
    11011089    CHARACTER(len=9) :: ret      !! String representation of the octal number on succes, 'ukn' otherwise
    11021090    INTEGER :: u,g,o
    1103     IF (.NOT.chk_pm(oct_perm)) THEN 
     1091    IF (.NOT.chk_pm(oct_perm)) THEN
    11041092      ret = "ukn" ; RETURN
    11051093    ENDIF
    … …  
    11691157
    11701158  SUBROUTINE chrono_start(this)
    1171     !! Start the chrono. 
     1159    !! Start the chrono.
    11721160    !!
    11731161    !! @note
    … …  
    11801168    ENDIF
    11811169    this%on_run = .true.
    1182   END SUBROUTINE chrono_start 
     1170  END SUBROUTINE chrono_start
    11831171
    11841172  SUBROUTINE chrono_stop(this)
    … …  
    11971185  END SUBROUTINE chrono_reset
    11981186
    1199   SUBROUTINE chrono_get(this,cpu,clock,units) 
     1187  SUBROUTINE chrono_get(this,cpu,clock,units)
    12001188    !! Get elapsed time since last call of start or reset methods.
    1201     !! 
     1189    !!
    12021190    !! The method computes the time elapsed in two ways :
    12031191    !!
    12041192    !! - If the [[fsystem(module):chrono(type)]] is not running, the method retruns 0.
    1205     !! - Otherwise, elapsed time since the last call of 
     1193    !! - Otherwise, elapsed time since the last call of
    12061194    !!   [[chrono(type):start(bound)]] (or [[chrono(type):reset(bound)]]).
    12071195    OBJECT(chrono), INTENT(in)             :: this
    … …  
    12091197    REAL(kind=8), INTENT(out), OPTIONAL    :: cpu
    12101198      !! Elapsed cpu time in seconds by default (see units argument).
    1211     REAL(kind=8), INTENT(out), OPTIONAL    :: clock 
     1199    REAL(kind=8), INTENT(out), OPTIONAL    :: clock
    12121200      !! Elapsed system clock time in seconds by default (see units argument).
    12131201    CHARACTER(len=2), INTENT(in), OPTIONAL :: units
    12141202      !! A two characters wide string with the units to convert in. Units should
    1215       !! be one of the following : 'ms', 's' (default), 'm', 'h' or 'd'. 
     1203      !! be one of the following : 'ms', 's' (default), 'm', 'h' or 'd'.
    12161204    CHARACTER(len=2) :: zu
    12171205    REAL(kind=8)     :: cu, fact
    … …  
    12231211      ENDIF
    12241212      IF (PRESENT(clock)) THEN
    1225         CALL SYSTEM_CLOCK(ck,r,m) 
     1213        CALL SYSTEM_CLOCK(ck,r,m)
    12261214        clock = c2t(ck,this%clock_start,r,m)
    12271215      ENDIF
    … …  
    12311219    ENDIF
    12321220    fact = 1d0
    1233     zu = 's' 
     1221    zu = 's'
    12341222    IF (PRESENT(units))  THEN
    12351223      zu = units
    … …  
    12421230      END SELECT
    12431231    ENDIF
    1244     IF (PRESENT(cpu)) cpu = cpu / fact 
     1232    IF (PRESENT(cpu)) cpu = cpu / fact
    12451233    IF (PRESENT(clock)) clock = clock / fact
    12461234  END SUBROUTINE chrono_get
    … …  
    12491237    !! Get the real-time between two clock counts from system_clock.
    12501238    INTEGER(kind=8), INTENT(in) :: e !! Final clock count
    1251     INTEGER(kind=8), INTENT(in) :: i !! Initial clock count 
     1239    INTEGER(kind=8), INTENT(in) :: i !! Initial clock count
    12521240    INTEGER(kind=8), INTENT(in) :: r !! Clock count rate
    12531241    INTEGER(kind=8), INTENT(in) :: m !! Maximum Clock count value
Note: See TracChangeset for help on using the changeset viewer.