Ignore:
Timestamp:
Apr 26, 2024, 4:27:26 PM (8 months ago)
Author:
slebonnois
Message:

Titan PCM update : optics + microphysics

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r3090 r3318  
    428428    CHARACTER(len=:), ALLOCATABLE :: opath
    429429      !! A Fortran allocated string with the parent directory path or an empty string if method fails
     430    CHARACTER(len=:), ALLOCATABLE :: cpath
    430431    TYPE(C_PTR) :: zpath
    431432    IF (LEN_TRIM(path) == 0) THEN
    … …  
    433434      RETURN
    434435    ENDIF
    435     zpath = dirname_c(cstring(ADJUSTL(path)))
     436    cpath = cstring(ADJUSTL(path))
     437    zpath = dirname_c(cpath)
    436438    IF (.NOT.C_ASSOCIATED(zpath)) THEN
    437439      opath = ""
    … …  
    448450    CHARACTER(len=:), ALLOCATABLE :: opath
    449451      !! The basename of the path or an empty string if method fails
     452    CHARACTER(len=:), ALLOCATABLE :: cpath
    450453    TYPE(C_PTR) :: zpath
    451454    IF (LEN_TRIM(path) == 0) THEN
    … …  
    453456      RETURN
    454457    ENDIF
    455     zpath = basename_c(cstring(ADJUSTL(path)))
     458    cpath = cstring(ADJUSTL(path))
     459    zpath = basename_c(cpath)
    456460    IF (.NOT.C_ASSOCIATED(zpath)) THEN
    457461      opath = ""
    … …  
    472476    CHARACTER(len=:), ALLOCATABLE :: opath
    473477      !! The absolute of the path or an empty string if method fails
     478    CHARACTER(len=:), ALLOCATABLE :: cpath
    474479    TYPE(C_PTR) :: zpath
    475     zpath = realpath_c(cstring(ADJUSTL(path)))
     480    cpath = cstring(ADJUSTL(path))
     481    zpath = realpath_c(cpath)
    476482    IF (.NOT.C_ASSOCIATED(zpath)) THEN
    477483      opath = ""
    … …  
    490496                                    reldir  !! A directory path from which output should be relative to
    491497    CHARACTER(len=:), ALLOCATABLE :: res    !! An allocated string with the resulting path
     498    CHARACTER(len=:), ALLOCATABLE :: cpath1,cpath2
    492499    TYPE(C_PTR) :: zpath
    493     zpath = relpath_c(cstring(ADJUSTL(path)),cstring(ADJUSTL(reldir)))
     500    cpath1 = cstring(ADJUSTL(path))
     501    cpath2 = cstring(ADJUSTL(reldir))
     502    zpath = relpath_c(cpath1,cpath2)
    494503    IF (.NOT.C_ASSOCIATED(zpath)) THEN
    495504      res = TRIM(ADJUSTL(path))
    … …  
    520529    CHARACTER(len=*), INTENT(in)  :: output !! Output file path destination.
    521530    LOGICAL :: ret                          !! True on success, false otherwise.
     531    CHARACTER(len=:), ALLOCATABLE :: cpath1,cpath2
     532
    522533    IF (LEN_TRIM(input) == 0 .OR. LEN_TRIM(output) == 0 .OR. input == output) THEN
    523534      ret = .false.
    524535    ELSE
    525       ret = INT(copy_c(cstring(ADJUSTL(output)),cstring(ADJUSTL(input)))) == 0
     536      cpath1 = cstring(ADJUSTL(output))
     537      cpath2 = cstring(ADJUSTL(input))
     538      ret = INT(copy_c(cpath1,cpath2)) == 0
    526539    ENDIF
    527540    RETURN
    … …  
    532545    CHARACTER(len=*), INTENT(in)  :: path !! A string with the (valid) file path to delete
    533546    LOGICAL :: ret                        !! True on success, false otherwise.
     547    CHARACTER(len=:), ALLOCATABLE :: cpath
    534548    IF (LEN_TRIM(path) == 0) THEN
    535549      ret = .false.
    536550    ELSE
    537       ret = INT(remove_c(cstring(ADJUSTL(path)))) == 0
     551      cpath = cstring(ADJUSTL(path))
     552      ret = INT(remove_c(cpath)) == 0
    538553    ENDIF
    539554    RETURN
    … …  
    545560                                    new    !! A string with the new name of the path
    546561    LOGICAL :: ret                         !! True on success, false otherwise.
     562    CHARACTER(len=:), ALLOCATABLE :: cpath1,cpath2
    547563    IF (LEN_TRIM(old) == 0.OR.LEN_TRIM(new) == 0) THEN
    548564      ret = .false.
    549565    ELSE
    550       ret = INT(rename_c(cstring(ADJUSTL(old)),cstring(ADJUSTL(new)))) == 0
     566      cpath1 = cstring(ADJUSTL(old))
     567      cpath2 = cstring(ADJUSTL(new))
     568      ret = INT(rename_c(cpath1,cpath2)) == 0
    551569    ENDIF
    552570    RETURN
    … …  
    559577    LOGICAL  :: ret                      !! True on success, false otherwise.
    560578    INTEGER(kind=C_INT) :: zmode
     579    CHARACTER(len=:), ALLOCATABLE :: cpath
    561580    IF (LEN_TRIM(path) == 0) THEN
    562581      ret = .false.
    563582    ELSE
    564583      zmode = INT(oct_2_dec(mode),kind=C_INT)
    565       ret = INT(chmod_c(cstring(ADJUSTL(path)), zmode)) == 0
     584      cpath = cstring(ADJUSTL(path))
     585      ret = INT(chmod_c(cpath, zmode)) == 0
    566586    ENDIF
    567587    RETURN
    … …  
    572592    CHARACTER(len=*), INTENT(in) :: path !! Path of the new working directory
    573593    LOGICAL :: ret                       !! True on success, false otherwise.
     594    CHARACTER(len=:), ALLOCATABLE :: cpath
    574595    IF (LEN_TRIM(path) == 0) THEN
    575596      ret = .false.
    576597    ELSE
    577       ret = INT(chdir_c(cstring(ADJUSTL(path)))) == 0
     598      cpath = cstring(ADJUSTL(path))
     599      ret = INT(chdir_c(cpath)) == 0
    578600    ENDIF
    579601    RETURN
    … …  
    595617    INTEGER :: zmode
    596618    LOGICAL :: zperm
     619    CHARACTER(len=:), ALLOCATABLE :: cpath
     620
    597621    IF (LEN_TRIM(path) == 0) THEN
    598622      ret = .false.
    … …  
    605629        zmode = oct_2_dec(mode)
    606630      ENDIF
     631      cpath = cstring(ADJUSTL(path))
    607632      zperm = .false. ; IF (PRESENT(permissive)) zperm = permissive
    608633      IF (zperm) THEN
    609         ret = INT(mkdirp_c(cstring(ADJUSTL(path)),INT(zmode,kind=C_INT))) == 0
     634        ret = INT(mkdirp_c(cpath,INT(zmode,kind=C_INT))) == 0
    610635      ELSE
    611         ret = INT(mkdir_c(cstring(ADJUSTL(path)),INT(zmode,kind=C_INT))) == 0
     636        ret = INT(mkdir_c(cpath,INT(zmode,kind=C_INT))) == 0
    612637      ENDIF
    613638    ENDIF
    … …  
    627652      !! True on success, false otherwise.
    628653    LOGICAL :: zforce
     654    CHARACTER(len=:), ALLOCATABLE :: cpath
    629655    IF (LEN_TRIM(path) == 0) THEN
    630656      ret = .false.
    631657    ELSE
    632658      zforce = .false. ; IF (PRESENT(forced)) zforce = forced
     659      cpath = cstring(ADJUSTL(path))
    633660      IF (.NOT.zforce) THEN
    634         ret = INT(rmdir_c(cstring(ADJUSTL(path)))) == 0
     661        ret = INT(rmdir_c(cpath)) == 0
    635662      ELSE
    636         ret = INT(rmdirf_c(cstring(ADJUSTL(path)))) == 0
     663        ret = INT(rmdirf_c(cpath)) == 0
    637664      ENDIF
    638665    ENDIF
    … …  
    668695    INTEGER(kind=c_long)          :: f
    669696    CHARACTER(len=20,kind=C_CHAR) :: ta,tm,tc
     697    CHARACTER(len=:), ALLOCATABLE :: cpath
    670698    IF (LEN_TRIM(path) == 0) THEN
    671699      ret = .false.; RETURN
    … …  
    677705      ! set default values
    678706      pe=-1 ; ty=-1 ; ud=-1 ; gd=-1 ; fs=-1 ; at="" ; mt="" ; ct=""
    679       ret = INT(fstat_c(cstring(ADJUSTL(path)),p,l,t,u,g,f,ta,tm,tc)) == 0
     707      cpath = cstring(ADJUSTL(path))
     708      ret = INT(fstat_c(cpath,p,l,t,u,g,f,ta,tm,tc)) == 0
    680709      IF (ret) THEN
    681710        pe=INT(p) ; ln=INT(l) ; ty=INT(t) ; ud=INT(u) ; gd=INT(g)
    … …  
    752781    LOGICAL :: ret                              !! True on success, false otherwise.
    753782    INTEGER(kind=C_INT) :: zp
     783    CHARACTER(len=:), ALLOCATABLE :: cpath
    754784    IF (LEN_TRIM(path) == 0) THEN
    755785      ret = .false.
    … …  
    757787      zp = 0 ; IF (PRESENT(permission)) zp = INT(permission,kind=C_INT)
    758788      ! Defaults are set in the C function.
    759       ret = INT(access_c(cstring(ADJUSTL(path)),zp)) == 0
     789      cpath = cstring(ADJUSTL(path))
     790      ret = INT(access_c(cpath,zp)) == 0
    760791    ENDIF
    761792    RETURN
    … …  
    822853    INTEGER                       :: zmd,zt,zp
    823854    CHARACTER(len=:), ALLOCATABLE :: b,e
     855    CHARACTER(len=:), ALLOCATABLE :: cpath
    824856    ret = .false.
    825857    ! Checking for existence
    … …  
    856888    ENDIF
    857889    zp = 0 ; IF(PRESENT(permissive)) THEN ; IF(permissive) zp=1 ; ENDIF
    858     ret = INT(create_c(cstring(ADJUSTL(path)),INT(zmd,kind=C_INT),INT(zt,kind=C_INT),INT(zp,kind=C_INT))) == 0
     890
     891    cpath = cstring(ADJUSTL(path))
     892    ret = INT(create_c(cpath,INT(zmd,kind=C_INT),INT(zt,kind=C_INT),INT(zp,kind=C_INT))) == 0
    859893    RETURN
    860894  END FUNCTION fs_create
Note: See TracChangeset for help on using the changeset viewer.