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

Titan PCM update : optics + microphysics

Location:
trunk/LMDZ.TITAN/libf/muphytitan
Files:
5 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

  • trunk/LMDZ.TITAN/libf/muphytitan/mm_clouds.f90

    r3090 r3318  
    112112      mm_ccn_vsed(:) = wsettle(mm_play,mm_temp,mm_zlay,mm_drho,mm_drad)
    113113
    114       ! Computes flux [kg.m-2.s-1] and precipitation [m.iphysiq] of ccn
     114      ! Computes flux [kg.m-2.s-1] and precipitation [kg.m-2.iphysiq] of ccn
    115115      mm_ccn_flux(:) = get_mass_flux(mm_rhoaer,mm_m3ccn(:))
    116       mm_ccn_prec = SUM(zdm3n*mm_dzlev)
    117 
    118       ! Computes flux [kg.m-2.s-1] and precipitation [m.iphysiq] of ices
     116      mm_ccn_prec = SUM(zdm3n*mm_dzlev*mm_rhoaer)
     117
     118      ! Computes flux [kg.m-2.s-1] and precipitation [kg.m-2.iphysiq] of ices
    119119      DO i = 1, mm_nesp
    120120        mm_ice_fluxes(:,i) = get_mass_flux(mm_xESPS(i)%rho,(3._mm_wp*mm_m3ice(:,i))/(4._mm_wp*mm_pi))
    121         mm_ice_prec(i) = SUM(zdm3i(:,i)*mm_dzlev)
     121        mm_ice_prec(i) = SUM(zdm3i(:,i)*mm_dzlev*mm_xESPS(i)%rho)
    122122      ENDDO
    123123
    … …  
    258258    ! Saturation ratio
    259259    Xsat = zvapX / qsat
     260
    260261   
    261262    ! Gets nucleation rate (ccn radius is the monomer !)
    … …  
    740741    Us = (2._mm_wp * rad**2 * rho * mm_effg(z)) / (9._mm_wp * mm_eta_g(t))
    741742   
    742     ! Computes settling velocity (correction factor : x2.0)
    743     w = Us * Fc * 2._mm_wp
     743    ! Computes settling velocity (correction factor : x3.0)
     744    w = Us * Fc * 3._mm_wp
    744745  END FUNCTION wsettle
    745746

  • trunk/LMDZ.TITAN/libf/muphytitan/mm_globals.f90

    r3090 r3318  
    227227  REAL(kind=mm_wp), PARAMETER :: mm_rgas = mm_kboltz * mm_navo
    228228  !> Desorption energy (\(J\)) (nucleation).
    229   REAL(kind=mm_wp), PARAMETER :: mm_fdes = 0.288e-19_mm_wp
     229  REAL(kind=mm_wp), PARAMETER :: mm_fdes = 1.519e-20_mm_wp
    230230  !> Surface diffusion energy (\(J\)) (nucleation).
    231   REAL(kind=mm_wp), PARAMETER :: mm_fdif = 0.288e-20_mm_wp
     231  REAL(kind=mm_wp), PARAMETER :: mm_fdif = 1.519e-21_mm_wp
    232232  !> Jump frequency (\(s^{-1}\)) (nucleation).
    233233  REAL(kind=mm_wp), PARAMETER :: mm_nus = 1.e+13_mm_wp
    … …  
    429429  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_drho
    430430
    431   !> Aerosols precipitations (m).
     431  !> Aerosols precipitations (kg.m-2.s-1).
    432432  !!
    433433  !! Aerosols precipitations take into account both spherical and fractal modes.
    … …  
    435435  REAL(kind=mm_wp), SAVE :: mm_aer_prec = 0._mm_wp
    436436
    437   !> CCN precipitations (m).
     437  !> CCN precipitations (kg.m-2.s-1).
    438438  !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
    439439  REAL(kind=mm_wp), SAVE :: mm_ccn_prec = 0._mm_wp
    … …  
    505505  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_ccn_flux
    506506
    507   !> Ice components precipitations (m).
     507  !> Ice components precipitations (kg.m-2.s-1).
    508508  !!
    509509  !! It is a vector of [[mm_globals(module):mm_nesp(variable)]] values which share the same indexing
    … …  
    14311431    ! Initialization :
    14321432    Ntot = m0ccn
    1433     Vtot = pifac*m3ccn + SUM(m3ice)
    1434     Wtot = pifac*m3ccn*mm_rhoaer + SUM(m3ice*mm_xESPS(:)%rho)
     1433    Vtot = pifac*m3ccn + pifac*SUM(m3ice)
     1434    Wtot = pifac*m3ccn*mm_rhoaer + pifac*SUM(m3ice*mm_xESPS(:)%rho)
    14351435
    14361436    IF (Ntot <= mm_m0n_min .OR. Vtot <= mm_m3cld_min) THEN

  • trunk/LMDZ.TITAN/libf/muphytitan/mm_haze.f90

    r3090 r3318  
    117117
    118118      ! Computes precipitations
    119       mm_aer_prec = SUM(zdm3as*mm_dzlev) + SUM(zdm3af*mm_dzlev)
     119      mm_aer_prec = SUM(zdm3as*mm_dzlev*mm_rhoaer) + SUM(zdm3af*mm_dzlev*mm_rhoaer)
    120120
    121121      ! Updates tendencies

  • trunk/LMDZ.TITAN/libf/muphytitan/mm_microphysic.f90

    r3090 r3318  
    163163  END FUNCTION muphys_nocld
    164164
    165   SUBROUTINE mm_diagnostics(aer_prec,aer_s_w,aer_f_w,aer_s_flux,aer_f_flux,ccn_prec,ccn_w,ccn_flux,ice_prec,ice_fluxes,gazs_sat)
     165  SUBROUTINE mm_diagnostics(dt,aer_prec,aer_s_w,aer_f_w,aer_s_flux,aer_f_flux,ccn_prec,ccn_w,ccn_flux,ice_prec,ice_fluxes,gazs_sat)
    166166    !! Get various diagnostic fields of the microphysics.
    167167    !!
    … …  
    185185    !! __ccnprec__, __iceprec__, __icefluxes__ and __gazsat__ are always set to 0 if clouds
    186186    !! microphysics is disabled (see [[mm_globals(module):mm_w_clouds(variable)]] documentation).
    187     REAL(kind=mm_wp), INTENT(out), OPTIONAL                 :: aer_prec   !! Aerosols precipitations (both modes) (m).
    188     REAL(kind=mm_wp), INTENT(out), OPTIONAL                 :: ccn_prec   !! CCN precipitations (m).
     187    REAL(kind=8), INTENT(IN)                                :: dt         !! Physics timestep (s).
     188    REAL(kind=mm_wp), INTENT(out), OPTIONAL                 :: aer_prec   !! Aerosols precipitations (both modes) (kg.m-2.s-1).
     189    REAL(kind=mm_wp), INTENT(out), OPTIONAL                 :: ccn_prec   !! CCN precipitations (kg.m-2.s-1).
    189190    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: aer_s_w    !! Spherical aerosol settling velocity (\(m.s^{-1}\)).
    190191    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: aer_f_w    !! Fractal aerosol settling velocity (\(m.s^{-1}\)).
    … …  
    195196    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:,:) :: ice_fluxes !! Ice sedimentation fluxes (\(kg.m^{-2}.s^{-1}\)).
    196197    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:,:) :: gazs_sat   !! Condensible gaz saturation ratios (--).
    197     REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: ice_prec   !! Ice precipitations (m).
    198 
    199     IF (PRESENT(aer_prec))   aer_prec   = ABS(mm_aer_prec)
     198    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: ice_prec   !! Ice precipitations (kg.m-2.s-1).
     199
     200    IF (PRESENT(aer_prec))   aer_prec   = ABS(mm_aer_prec) / dt
    200201    IF (PRESENT(aer_s_w))    aer_s_w    = -mm_m3as_vsed(mm_nla:1:-1)
    201202    IF (PRESENT(aer_f_w))    aer_f_w    = -mm_m3af_vsed(mm_nla:1:-1)
    … …  
    204205
    205206    IF (mm_w_clouds) THEN
    206       IF (PRESENT(ccn_prec))   ccn_prec   = ABS(mm_ccn_prec)
    207       IF (PRESENT(ice_prec))   ice_prec   = ABS(mm_ice_prec)
     207      IF (PRESENT(ccn_prec))   ccn_prec   = ABS(mm_ccn_prec) / dt
     208      IF (PRESENT(ice_prec))   ice_prec   = ABS(mm_ice_prec) / dt
    208209      IF (PRESENT(ccn_w))      ccn_w      = mm_ccn_vsed(mm_nla:1:-1)
    209210      IF (PRESENT(ccn_flux))   ccn_flux   = mm_ccn_flux(mm_nla:1:-1)
Note: See TracChangeset for help on using the changeset viewer.