Ignore:
Timestamp:
Jan 24, 2018, 10:24:24 PM (7 years ago)
Author:
jvatant
Message:

Making Titan's hazy again - part II
+ Major updates of J.Burgalat YAMMS library and optical coupling, including :
++ Added the routines for haze optics inside YAMMS
++ Calling rad. transf. with interactive haze is plugged
in but should stay unactive as long as the microphysics is
in test phase : cf "uncoupl_optic_haze" flag : true for now !
++ Also some sanity checks for negative tendencies and
some others upkeep of YAMMS model
+ Also added a temporary CPP key USE_QTEST in physiq_mod
that enables to have microphysical tendencies separated
from dynamics for debugging and test phases
-- JVO and JB

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r1793 r1897  
    1 ! Copyright Jérémie Burgalat (2010-2015)
     1! Copyright Jérémie Burgalat (2010-2015,2017)
    22!
    3 ! burgalat.jeremie@gmail.com
     3! jeremie.burgalat@univ-reims.fr
    44!
    55! This software is a computer program whose purpose is to provide configuration
    … …  
    3333
    3434!! file: fsystem.F90
    35 !! summary: File system methods source file
    36 !! date: 2013-2015
    37 !! author: Burgalat
     35!! summary: File system methods source file.
     36!! author: J. Burgalat
     37!! date: 2013-2015,2017
     38
    3839
    3940#include "defined.h"
    … …  
    4849
    4950  PRIVATE :: get_umask
     51  PRIVATE :: c2t
    5052
    5153  INTEGER, PARAMETER :: MAX_PATH = 512 !! Maximum length of a path
    5254
    53 
     55  TYPE, PUBLIC :: chrono
     56    !! Define a simple chronometer
     57    !!
     58    !! 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   
     60      !! Starting CPU time
     61    INTEGER(kind=8), PRIVATE :: clock_start = 0d0
     62      !! Starting clock time
     63    LOGICAL, PRIVATE         :: on_run = .false.
     64      !! Chrono running state.
     65#if HAVE_FTNPROC
     66    CONTAINS
     67      PROCEDURE :: is_running => chrono_is_running
     68      PROCEDURE :: start      => chrono_start
     69      PROCEDURE :: stop       => chrono_stop
     70      PROCEDURE :: reset      => chrono_reset
     71      PROCEDURE :: get        => chrono_get
     72#endif
     73  END TYPE chrono
     74
     75#ifndef FORD_DOC
     76  ! C interfaces
    5477  INTERFACE
    55 
    5678    FUNCTION strlen_c(s) RESULT(length) bind(C,name="strlen")
    5779      !! Get length of C-string up to (but not including) the terminator
    … …  
    6890
    6991    FUNCTION errno_c() BIND(C,name="c_get_errno")
    70       !! Get last error numbero
     92      !! Get last error numero
    7193      IMPORT C_INT
    7294      INTEGER(kind=C_INT) :: errno_c !! Last errno
    … …  
    209231      INTEGER(kind=C_INT)                    :: mkdirp_c   !! 0 on success, last errno on failure
    210232    END FUNCTION mkdirp_c
     233
     234    FUNCTION copy_c(to,from) BIND(C,name="c_copy")
     235      !! Copy a file.
     236      IMPORT c_char, C_INT
     237      CHARACTER(kind=c_char), INTENT(in)  :: to(*)    !! Destination path.
     238      CHARACTER(kind=c_char), INTENT(in)  :: from(*)  !! Input file path to copy.
     239      INTEGER(kind=C_INT)                 :: copy_c !! 0 on success, 1 on failure.
     240    END FUNCTION copy_c
    211241
    212242    FUNCTION remove_c(path) BIND(C,name="c_remove")
    … …  
    255285    END FUNCTION termsize_c
    256286
     287    FUNCTION getCurrentRSS_c() BIND(C, name="c_getCurrentRSS")
     288      !! Get the current resident set size memory in bytes.
     289      IMPORT  C_SIZE_T
     290      INTEGER(kind=C_SIZE_T) :: getCurrentRSS_c !! Current resident set size in bytes (0 if not available).
     291    END FUNCTION getCurrentRSS_c
     292
     293    FUNCTION getPeakRSS_c() BIND(C, name="c_getPeakRSS")
     294      !! Get the peak resident set size memory in bytes.
     295      IMPORT  C_SIZE_T
     296      INTEGER(kind=C_SIZE_T) :: getPeakRSS_c !! Peak resident set size in bytes (0 if not available).
     297    END FUNCTION getPeakRSS_c
     298
     299    FUNCTION getSystemMemory_c(total,avail,free) BIND(C, name='c_getSystemMemory')
     300      !! Get global memory informations.
     301      IMPORT C_LONG_LONG,C_INT
     302      INTEGER(kind=C_LONG_LONG), INTENT(out) :: total             !! Total available memory.
     303      INTEGER(kind=C_LONG_LONG), INTENT(out) :: avail             !! Current available memory.
     304      INTEGER(kind=C_LONG_LONG), INTENT(out) :: free              !! Current free memory.
     305      INTEGER(kind=C_INT)                    :: getSystemMemory_c !! status, 0 on success, 1 otherwise.
     306    END FUNCTION getSystemMemory_c
    257307  END INTERFACE
    258 
     308#endif
    259309
    260310  CONTAINS
    … …  
    291341    !! @attention
    292342    !! The method does not free the underlying C string and it should be free using
    293     !! [[fsystem(module):free_c(interface)]] method.
     343    !! the subroutine free_c(_cstr_).
    294344    TYPE(C_PTR), INTENT(in) :: cstr
    295345      !! A TYPE(C_PTR) that represent the pointer to the C char array.
    … …  
    476526    RETURN
    477527  END FUNCTION fs_getcwd
     528
     529  FUNCTION fs_copy(input,output) RESULT(ret)
     530    !! Copy input file into output file.
     531    CHARACTER(len=*), INTENT(in)  :: input  !! Input file path to copy.
     532    CHARACTER(len=*), INTENT(in)  :: output !! Output file path destination.
     533    LOGICAL :: ret                          !! True on success, false otherwise.
     534    IF (LEN_TRIM(input) == 0 .OR. LEN_TRIM(output) == 0 .OR. input == output) THEN
     535      ret = .false.
     536    ELSE
     537      ret = INT(copy_c(cstring(ADJUSTL(output)),cstring(ADJUSTL(input)))) == 0
     538    ENDIF
     539    RETURN
     540  END FUNCTION fs_copy
    478541
    479542  FUNCTION fs_remove(path) RESULT(ret)
    … …  
    880943  END SUBROUTINE fs_msleep
    881944
     945  FUNCTION fs_get_memory(peak,units) RESULT(mem)
     946    !! Get the memory usage of the current process.
     947    LOGICAL, INTENT(in), OPTIONAL          :: peak  !! True to retrieve the peak RSS memory, otherwise retrieve the current RSS memory. Default to False.
     948    CHARACTER(len=*), INTENT(in), OPTIONAL :: units !! Output units: either 'B' (Bytes),'KB' (Kilo-),'MB' (Mega-),'GB' (Giga-). Default to 'B'.
     949    REAL(kind=8)                           :: mem   !! Memory usage.
     950    LOGICAL          :: zpeak
     951    CHARACTER(len=2) :: zunits
     952    zpeak = .false. ; IF (PRESENT(peak)) zpeak = peak
     953    zunits = 'B '   ; IF (PRESENT(units)) zunits = units
     954    IF (zunits /= 'B' .AND. zunits /= 'KB' .AND. zunits /= 'MB' .AND. zunits /= 'GB') zunits = 'B '
     955    IF (zpeak) THEN
     956      mem = REAL(getPeakRSS_c(),kind=8)
     957    ELSE
     958      mem = REAL(getCurrentRSS_c(),kind=8)
     959    ENDIF
     960    IF (zunits == 'KB') THEN
     961      mem = mem / 1024d0
     962    ELSE IF (zunits == 'MB') THEN
     963      mem = mem / 1048576d0
     964    ELSE IF (zunits == 'GB') THEN
     965      mem = mem / 1073741824d0
     966    ENDIF
     967    RETURN
     968  END FUNCTION fs_get_memory
     969
     970  FUNCTION fs_get_system_memory(total,available,free,units) RESULT(ret)
     971    !! Get informations about system memory.
     972    !!
     973    !! If no informations is available, output arguments are set to 0 and the method returns false.
     974    REAL(kind=8), INTENT(out), OPTIONAL    :: total      !! Total available memory.
     975    REAL(kind=8), INTENT(out), OPTIONAL    :: available  !! Current available memory.
     976    REAL(kind=8), INTENT(out), OPTIONAL    :: free       !! Current free memory.
     977    CHARACTER(len=*), INTENT(in), OPTIONAL :: units      !! Output units: either 'B' (Bytes),'KB' (Kilo-),'MB' (Mega-),'GB' (Giga-). Default to 'B'.
     978    LOGICAL                                :: ret        !! True on success, false otherwise.
     979    LOGICAL          :: zpeak
     980    CHARACTER(len=2) :: zunits
     981    INTEGER(kind=8)  :: ztot,zava,zfre   
     982
     983    zunits = 'B '   ; IF (PRESENT(units)) zunits = units
     984    IF (zunits /= 'B' .AND. zunits /= 'KB' .AND. zunits /= 'MB' .AND. zunits /= 'GB') zunits = 'B '
     985    ret = INT(getSystemMemory_c(ztot,zava,zfre),kind=4) == 0
     986    ztot = ztot * 1024 ; zava = zava * 1024 ; zfre = zfre * 1024
     987
     988    IF (PRESENT(total))     total     = ztot
     989    IF (PRESENT(available)) available = zava
     990    IF (PRESENT(free))      free      = zfre
     991    IF (.NOT.ret) RETURN
     992
     993    IF (zunits == 'KB') THEN
     994      IF (PRESENT(total))     total     = ztot / 1024d0
     995      IF (PRESENT(available)) available = zava / 1024d0
     996      IF (PRESENT(free))      free      = zfre / 1024d0
     997    ELSE IF (zunits == 'MB') THEN
     998      IF (PRESENT(total))     total     = ztot / 1048576d0
     999      IF (PRESENT(available)) available = zava / 1048576d0
     1000      IF (PRESENT(free))      free      = zfre / 1048576d0
     1001    ELSE IF (zunits == 'GB') THEN
     1002      IF (PRESENT(total))     total     = ztot / 1073741824d0
     1003      IF (PRESENT(available)) available = zava / 1073741824d0
     1004      IF (PRESENT(free))      free      = zfre / 1073741824d0
     1005    ENDIF
     1006    RETURN
     1007  END FUNCTION fs_get_system_memory
     1008
     1009
    8821010!===============================================================================
    8831011! MODULE MISCELLANEOUS METHODS
    … …  
    10321160  END FUNCTION sz2str
    10331161
     1162  FUNCTION chrono_is_running(this) RESULT (ret)
     1163    !! Get chrono's state.
     1164    OBJECT(chrono), INTENT(in) :: this !! Chrono object reference.
     1165    LOGICAL :: ret                    !! Running state.
     1166    ret = this%on_run
     1167    RETURN
     1168  END FUNCTION chrono_is_running
     1169
     1170  SUBROUTINE chrono_start(this)
     1171    !! Start the chrono.
     1172    !!
     1173    !! @note
     1174    !! Calling the method multiple times without explicitly stopping the chrono
     1175    !! [[chrono(type):stop(bound)]] does nothing (except for the first called).
     1176    OBJECT(chrono), INTENT(inout) :: this  !! Chrono object reference.
     1177    IF (.NOT.this%on_run) THEN
     1178      CALL CPU_TIME(this%cpu_start)
     1179      CALL SYSTEM_CLOCK(this%clock_start)
     1180    ENDIF
     1181    this%on_run = .true.
     1182  END SUBROUTINE chrono_start
     1183
     1184  SUBROUTINE chrono_stop(this)
     1185    !! Stop the chrono.
     1186    OBJECT(chrono), INTENT(inout) :: this !! Chrono object reference.
     1187    REAL(kind=8)    :: ecpu
     1188    INTEGER(kind=8) :: eclk,nbm,nbr
     1189    this%on_run = .false.
     1190  END SUBROUTINE chrono_stop
     1191
     1192  SUBROUTINE chrono_reset(this)
     1193    !! Reset the chrono's internal elapsed times.
     1194    OBJECT(chrono), INTENT(inout) :: this !! Chrono object reference.
     1195    CALL CPU_TIME(this%cpu_start)
     1196    CALL SYSTEM_CLOCK(this%clock_start)
     1197  END SUBROUTINE chrono_reset
     1198
     1199  SUBROUTINE chrono_get(this,cpu,clock,units)
     1200    !! Get elapsed time since last call of start or reset methods.
     1201    !!
     1202    !! The method computes the time elapsed in two ways :
     1203    !!
     1204    !! - If the [[fsystem(module):chrono(type)]] is not running, the method retruns 0.
     1205    !! - Otherwise, elapsed time since the last call of
     1206    !!   [[chrono(type):start(bound)]] (or [[chrono(type):reset(bound)]]).
     1207    OBJECT(chrono), INTENT(in)             :: this
     1208      !! Chrono object reference.
     1209    REAL(kind=8), INTENT(out), OPTIONAL    :: cpu
     1210      !! Elapsed cpu time in seconds by default (see units argument).
     1211    REAL(kind=8), INTENT(out), OPTIONAL    :: clock
     1212      !! Elapsed system clock time in seconds by default (see units argument).
     1213    CHARACTER(len=2), INTENT(in), OPTIONAL :: units
     1214      !! 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'.
     1216    CHARACTER(len=2) :: zu
     1217    REAL(kind=8)     :: cu, fact
     1218    INTEGER(kind=8)  :: ck, r, m
     1219    IF (this%on_run) THEN
     1220      IF (PRESENT(cpu)) THEN
     1221        CALL CPU_TIME(cu)
     1222        cpu = (cu - this%cpu_start)
     1223      ENDIF
     1224      IF (PRESENT(clock)) THEN
     1225        CALL SYSTEM_CLOCK(ck,r,m)
     1226        clock = c2t(ck,this%clock_start,r,m)
     1227      ENDIF
     1228    ELSE
     1229      IF (PRESENT(cpu))   cpu = 0d0
     1230      IF (PRESENT(clock)) clock = 0d0
     1231    ENDIF
     1232    fact = 1d0
     1233    zu = 's'
     1234    IF (PRESENT(units))  THEN
     1235      zu = units
     1236      SELECT CASE(zu)
     1237        CASE ('d') ; fact = 3600d0*24.
     1238        CASE ('h') ; fact = 3600d0
     1239        CASE ('m') ; fact = 60d0
     1240        CASE ('ms') ; fact = 1d-3
     1241        CASE DEFAULT ; fact = 1d0
     1242      END SELECT
     1243    ENDIF
     1244    IF (PRESENT(cpu)) cpu = cpu / fact
     1245    IF (PRESENT(clock)) clock = clock / fact
     1246  END SUBROUTINE chrono_get
     1247
     1248  FUNCTION c2t(e,i,r,m) RESULT(time)
     1249    !! Get the real-time between two clock counts from system_clock.
     1250    INTEGER(kind=8), INTENT(in) :: e !! Final clock count
     1251    INTEGER(kind=8), INTENT(in) :: i !! Initial clock count
     1252    INTEGER(kind=8), INTENT(in) :: r !! Clock count rate
     1253    INTEGER(kind=8), INTENT(in) :: m !! Maximum Clock count value
     1254    REAL(kind=8)    :: time          !! Time in seconds
     1255    INTEGER(kind=8) :: nc
     1256    nc = e-i ; IF (e < i) nc = nc+m
     1257    time = REAL(nc,kind=8)/r
     1258    RETURN
     1259  END FUNCTION c2t
    10341260END MODULE FSYSTEM
     1261
Note: See TracChangeset for help on using the changeset viewer.