Index: trunk/LMDZ.TITAN/libf/muphytitan/fsystem.F90 =================================================================== --- trunk/LMDZ.TITAN/libf/muphytitan/fsystem.F90 (revision 3090) +++ trunk/LMDZ.TITAN/libf/muphytitan/fsystem.F90 (revision 3318) @@ -428,4 +428,5 @@ CHARACTER(len=:), ALLOCATABLE :: opath !! A Fortran allocated string with the parent directory path or an empty string if method fails + CHARACTER(len=:), ALLOCATABLE :: cpath TYPE(C_PTR) :: zpath IF (LEN_TRIM(path) == 0) THEN @@ -433,5 +434,6 @@ RETURN ENDIF - zpath = dirname_c(cstring(ADJUSTL(path))) + cpath = cstring(ADJUSTL(path)) + zpath = dirname_c(cpath) IF (.NOT.C_ASSOCIATED(zpath)) THEN opath = "" @@ -448,4 +450,5 @@ CHARACTER(len=:), ALLOCATABLE :: opath !! The basename of the path or an empty string if method fails + CHARACTER(len=:), ALLOCATABLE :: cpath TYPE(C_PTR) :: zpath IF (LEN_TRIM(path) == 0) THEN @@ -453,5 +456,6 @@ RETURN ENDIF - zpath = basename_c(cstring(ADJUSTL(path))) + cpath = cstring(ADJUSTL(path)) + zpath = basename_c(cpath) IF (.NOT.C_ASSOCIATED(zpath)) THEN opath = "" @@ -472,6 +476,8 @@ CHARACTER(len=:), ALLOCATABLE :: opath !! The absolute of the path or an empty string if method fails + CHARACTER(len=:), ALLOCATABLE :: cpath TYPE(C_PTR) :: zpath - zpath = realpath_c(cstring(ADJUSTL(path))) + cpath = cstring(ADJUSTL(path)) + zpath = realpath_c(cpath) IF (.NOT.C_ASSOCIATED(zpath)) THEN opath = "" @@ -490,6 +496,9 @@ reldir !! A directory path from which output should be relative to CHARACTER(len=:), ALLOCATABLE :: res !! An allocated string with the resulting path + CHARACTER(len=:), ALLOCATABLE :: cpath1,cpath2 TYPE(C_PTR) :: zpath - zpath = relpath_c(cstring(ADJUSTL(path)),cstring(ADJUSTL(reldir))) + cpath1 = cstring(ADJUSTL(path)) + cpath2 = cstring(ADJUSTL(reldir)) + zpath = relpath_c(cpath1,cpath2) IF (.NOT.C_ASSOCIATED(zpath)) THEN res = TRIM(ADJUSTL(path)) @@ -520,8 +529,12 @@ CHARACTER(len=*), INTENT(in) :: output !! Output file path destination. LOGICAL :: ret !! True on success, false otherwise. + CHARACTER(len=:), ALLOCATABLE :: cpath1,cpath2 + IF (LEN_TRIM(input) == 0 .OR. LEN_TRIM(output) == 0 .OR. input == output) THEN ret = .false. ELSE - ret = INT(copy_c(cstring(ADJUSTL(output)),cstring(ADJUSTL(input)))) == 0 + cpath1 = cstring(ADJUSTL(output)) + cpath2 = cstring(ADJUSTL(input)) + ret = INT(copy_c(cpath1,cpath2)) == 0 ENDIF RETURN @@ -532,8 +545,10 @@ CHARACTER(len=*), INTENT(in) :: path !! A string with the (valid) file path to delete LOGICAL :: ret !! True on success, false otherwise. + CHARACTER(len=:), ALLOCATABLE :: cpath IF (LEN_TRIM(path) == 0) THEN ret = .false. ELSE - ret = INT(remove_c(cstring(ADJUSTL(path)))) == 0 + cpath = cstring(ADJUSTL(path)) + ret = INT(remove_c(cpath)) == 0 ENDIF RETURN @@ -545,8 +560,11 @@ new !! A string with the new name of the path LOGICAL :: ret !! True on success, false otherwise. + CHARACTER(len=:), ALLOCATABLE :: cpath1,cpath2 IF (LEN_TRIM(old) == 0.OR.LEN_TRIM(new) == 0) THEN ret = .false. ELSE - ret = INT(rename_c(cstring(ADJUSTL(old)),cstring(ADJUSTL(new)))) == 0 + cpath1 = cstring(ADJUSTL(old)) + cpath2 = cstring(ADJUSTL(new)) + ret = INT(rename_c(cpath1,cpath2)) == 0 ENDIF RETURN @@ -559,9 +577,11 @@ LOGICAL :: ret !! True on success, false otherwise. INTEGER(kind=C_INT) :: zmode + CHARACTER(len=:), ALLOCATABLE :: cpath IF (LEN_TRIM(path) == 0) THEN ret = .false. ELSE zmode = INT(oct_2_dec(mode),kind=C_INT) - ret = INT(chmod_c(cstring(ADJUSTL(path)), zmode)) == 0 + cpath = cstring(ADJUSTL(path)) + ret = INT(chmod_c(cpath, zmode)) == 0 ENDIF RETURN @@ -572,8 +592,10 @@ CHARACTER(len=*), INTENT(in) :: path !! Path of the new working directory LOGICAL :: ret !! True on success, false otherwise. + CHARACTER(len=:), ALLOCATABLE :: cpath IF (LEN_TRIM(path) == 0) THEN ret = .false. ELSE - ret = INT(chdir_c(cstring(ADJUSTL(path)))) == 0 + cpath = cstring(ADJUSTL(path)) + ret = INT(chdir_c(cpath)) == 0 ENDIF RETURN @@ -595,4 +617,6 @@ INTEGER :: zmode LOGICAL :: zperm + CHARACTER(len=:), ALLOCATABLE :: cpath + IF (LEN_TRIM(path) == 0) THEN ret = .false. @@ -605,9 +629,10 @@ zmode = oct_2_dec(mode) ENDIF + cpath = cstring(ADJUSTL(path)) zperm = .false. ; IF (PRESENT(permissive)) zperm = permissive IF (zperm) THEN - ret = INT(mkdirp_c(cstring(ADJUSTL(path)),INT(zmode,kind=C_INT))) == 0 + ret = INT(mkdirp_c(cpath,INT(zmode,kind=C_INT))) == 0 ELSE - ret = INT(mkdir_c(cstring(ADJUSTL(path)),INT(zmode,kind=C_INT))) == 0 + ret = INT(mkdir_c(cpath,INT(zmode,kind=C_INT))) == 0 ENDIF ENDIF @@ -627,12 +652,14 @@ !! True on success, false otherwise. LOGICAL :: zforce + CHARACTER(len=:), ALLOCATABLE :: cpath IF (LEN_TRIM(path) == 0) THEN ret = .false. ELSE zforce = .false. ; IF (PRESENT(forced)) zforce = forced + cpath = cstring(ADJUSTL(path)) IF (.NOT.zforce) THEN - ret = INT(rmdir_c(cstring(ADJUSTL(path)))) == 0 + ret = INT(rmdir_c(cpath)) == 0 ELSE - ret = INT(rmdirf_c(cstring(ADJUSTL(path)))) == 0 + ret = INT(rmdirf_c(cpath)) == 0 ENDIF ENDIF @@ -668,4 +695,5 @@ INTEGER(kind=c_long) :: f CHARACTER(len=20,kind=C_CHAR) :: ta,tm,tc + CHARACTER(len=:), ALLOCATABLE :: cpath IF (LEN_TRIM(path) == 0) THEN ret = .false.; RETURN @@ -677,5 +705,6 @@ ! set default values pe=-1 ; ty=-1 ; ud=-1 ; gd=-1 ; fs=-1 ; at="" ; mt="" ; ct="" - ret = INT(fstat_c(cstring(ADJUSTL(path)),p,l,t,u,g,f,ta,tm,tc)) == 0 + cpath = cstring(ADJUSTL(path)) + ret = INT(fstat_c(cpath,p,l,t,u,g,f,ta,tm,tc)) == 0 IF (ret) THEN pe=INT(p) ; ln=INT(l) ; ty=INT(t) ; ud=INT(u) ; gd=INT(g) @@ -752,4 +781,5 @@ LOGICAL :: ret !! True on success, false otherwise. INTEGER(kind=C_INT) :: zp + CHARACTER(len=:), ALLOCATABLE :: cpath IF (LEN_TRIM(path) == 0) THEN ret = .false. @@ -757,5 +787,6 @@ zp = 0 ; IF (PRESENT(permission)) zp = INT(permission,kind=C_INT) ! Defaults are set in the C function. - ret = INT(access_c(cstring(ADJUSTL(path)),zp)) == 0 + cpath = cstring(ADJUSTL(path)) + ret = INT(access_c(cpath,zp)) == 0 ENDIF RETURN @@ -822,4 +853,5 @@ INTEGER :: zmd,zt,zp CHARACTER(len=:), ALLOCATABLE :: b,e + CHARACTER(len=:), ALLOCATABLE :: cpath ret = .false. ! Checking for existence @@ -856,5 +888,7 @@ ENDIF zp = 0 ; IF(PRESENT(permissive)) THEN ; IF(permissive) zp=1 ; ENDIF - ret = INT(create_c(cstring(ADJUSTL(path)),INT(zmd,kind=C_INT),INT(zt,kind=C_INT),INT(zp,kind=C_INT))) == 0 + + cpath = cstring(ADJUSTL(path)) + ret = INT(create_c(cpath,INT(zmd,kind=C_INT),INT(zt,kind=C_INT),INT(zp,kind=C_INT))) == 0 RETURN END FUNCTION fs_create Index: trunk/LMDZ.TITAN/libf/muphytitan/mm_clouds.f90 =================================================================== --- trunk/LMDZ.TITAN/libf/muphytitan/mm_clouds.f90 (revision 3090) +++ trunk/LMDZ.TITAN/libf/muphytitan/mm_clouds.f90 (revision 3318) @@ -112,12 +112,12 @@ mm_ccn_vsed(:) = wsettle(mm_play,mm_temp,mm_zlay,mm_drho,mm_drad) - ! Computes flux [kg.m-2.s-1] and precipitation [m.iphysiq] of ccn + ! Computes flux [kg.m-2.s-1] and precipitation [kg.m-2.iphysiq] of ccn mm_ccn_flux(:) = get_mass_flux(mm_rhoaer,mm_m3ccn(:)) - mm_ccn_prec = SUM(zdm3n*mm_dzlev) - - ! Computes flux [kg.m-2.s-1] and precipitation [m.iphysiq] of ices + mm_ccn_prec = SUM(zdm3n*mm_dzlev*mm_rhoaer) + + ! Computes flux [kg.m-2.s-1] and precipitation [kg.m-2.iphysiq] of ices DO i = 1, mm_nesp mm_ice_fluxes(:,i) = get_mass_flux(mm_xESPS(i)%rho,(3._mm_wp*mm_m3ice(:,i))/(4._mm_wp*mm_pi)) - mm_ice_prec(i) = SUM(zdm3i(:,i)*mm_dzlev) + mm_ice_prec(i) = SUM(zdm3i(:,i)*mm_dzlev*mm_xESPS(i)%rho) ENDDO @@ -258,4 +258,5 @@ ! Saturation ratio Xsat = zvapX / qsat + ! Gets nucleation rate (ccn radius is the monomer !) @@ -740,6 +741,6 @@ Us = (2._mm_wp * rad**2 * rho * mm_effg(z)) / (9._mm_wp * mm_eta_g(t)) - ! Computes settling velocity (correction factor : x2.0) - w = Us * Fc * 2._mm_wp + ! Computes settling velocity (correction factor : x3.0) + w = Us * Fc * 3._mm_wp END FUNCTION wsettle Index: trunk/LMDZ.TITAN/libf/muphytitan/mm_globals.f90 =================================================================== --- trunk/LMDZ.TITAN/libf/muphytitan/mm_globals.f90 (revision 3090) +++ trunk/LMDZ.TITAN/libf/muphytitan/mm_globals.f90 (revision 3318) @@ -227,7 +227,7 @@ REAL(kind=mm_wp), PARAMETER :: mm_rgas = mm_kboltz * mm_navo !> Desorption energy (\(J\)) (nucleation). - REAL(kind=mm_wp), PARAMETER :: mm_fdes = 0.288e-19_mm_wp + REAL(kind=mm_wp), PARAMETER :: mm_fdes = 1.519e-20_mm_wp !> Surface diffusion energy (\(J\)) (nucleation). - REAL(kind=mm_wp), PARAMETER :: mm_fdif = 0.288e-20_mm_wp + REAL(kind=mm_wp), PARAMETER :: mm_fdif = 1.519e-21_mm_wp !> Jump frequency (\(s^{-1}\)) (nucleation). REAL(kind=mm_wp), PARAMETER :: mm_nus = 1.e+13_mm_wp @@ -429,5 +429,5 @@ REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_drho - !> Aerosols precipitations (m). + !> Aerosols precipitations (kg.m-2.s-1). !! !! Aerosols precipitations take into account both spherical and fractal modes. @@ -435,5 +435,5 @@ REAL(kind=mm_wp), SAVE :: mm_aer_prec = 0._mm_wp - !> CCN precipitations (m). + !> CCN precipitations (kg.m-2.s-1). !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]]. REAL(kind=mm_wp), SAVE :: mm_ccn_prec = 0._mm_wp @@ -505,5 +505,5 @@ REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_ccn_flux - !> Ice components precipitations (m). + !> Ice components precipitations (kg.m-2.s-1). !! !! It is a vector of [[mm_globals(module):mm_nesp(variable)]] values which share the same indexing @@ -1431,6 +1431,6 @@ ! Initialization : Ntot = m0ccn - Vtot = pifac*m3ccn + SUM(m3ice) - Wtot = pifac*m3ccn*mm_rhoaer + SUM(m3ice*mm_xESPS(:)%rho) + Vtot = pifac*m3ccn + pifac*SUM(m3ice) + Wtot = pifac*m3ccn*mm_rhoaer + pifac*SUM(m3ice*mm_xESPS(:)%rho) IF (Ntot <= mm_m0n_min .OR. Vtot <= mm_m3cld_min) THEN Index: trunk/LMDZ.TITAN/libf/muphytitan/mm_haze.f90 =================================================================== --- trunk/LMDZ.TITAN/libf/muphytitan/mm_haze.f90 (revision 3090) +++ trunk/LMDZ.TITAN/libf/muphytitan/mm_haze.f90 (revision 3318) @@ -117,5 +117,5 @@ ! Computes precipitations - mm_aer_prec = SUM(zdm3as*mm_dzlev) + SUM(zdm3af*mm_dzlev) + mm_aer_prec = SUM(zdm3as*mm_dzlev*mm_rhoaer) + SUM(zdm3af*mm_dzlev*mm_rhoaer) ! Updates tendencies Index: trunk/LMDZ.TITAN/libf/muphytitan/mm_microphysic.f90 =================================================================== --- trunk/LMDZ.TITAN/libf/muphytitan/mm_microphysic.f90 (revision 3090) +++ trunk/LMDZ.TITAN/libf/muphytitan/mm_microphysic.f90 (revision 3318) @@ -163,5 +163,5 @@ END FUNCTION muphys_nocld - 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) + 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) !! Get various diagnostic fields of the microphysics. !! @@ -185,6 +185,7 @@ !! __ccnprec__, __iceprec__, __icefluxes__ and __gazsat__ are always set to 0 if clouds !! microphysics is disabled (see [[mm_globals(module):mm_w_clouds(variable)]] documentation). - REAL(kind=mm_wp), INTENT(out), OPTIONAL :: aer_prec !! Aerosols precipitations (both modes) (m). - REAL(kind=mm_wp), INTENT(out), OPTIONAL :: ccn_prec !! CCN precipitations (m). + REAL(kind=8), INTENT(IN) :: dt !! Physics timestep (s). + REAL(kind=mm_wp), INTENT(out), OPTIONAL :: aer_prec !! Aerosols precipitations (both modes) (kg.m-2.s-1). + REAL(kind=mm_wp), INTENT(out), OPTIONAL :: ccn_prec !! CCN precipitations (kg.m-2.s-1). REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:) :: aer_s_w !! Spherical aerosol settling velocity (\(m.s^{-1}\)). REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:) :: aer_f_w !! Fractal aerosol settling velocity (\(m.s^{-1}\)). @@ -195,7 +196,7 @@ REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:,:) :: ice_fluxes !! Ice sedimentation fluxes (\(kg.m^{-2}.s^{-1}\)). REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:,:) :: gazs_sat !! Condensible gaz saturation ratios (--). - REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:) :: ice_prec !! Ice precipitations (m). - - IF (PRESENT(aer_prec)) aer_prec = ABS(mm_aer_prec) + REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:) :: ice_prec !! Ice precipitations (kg.m-2.s-1). + + IF (PRESENT(aer_prec)) aer_prec = ABS(mm_aer_prec) / dt IF (PRESENT(aer_s_w)) aer_s_w = -mm_m3as_vsed(mm_nla:1:-1) IF (PRESENT(aer_f_w)) aer_f_w = -mm_m3af_vsed(mm_nla:1:-1) @@ -204,6 +205,6 @@ IF (mm_w_clouds) THEN - IF (PRESENT(ccn_prec)) ccn_prec = ABS(mm_ccn_prec) - IF (PRESENT(ice_prec)) ice_prec = ABS(mm_ice_prec) + IF (PRESENT(ccn_prec)) ccn_prec = ABS(mm_ccn_prec) / dt + IF (PRESENT(ice_prec)) ice_prec = ABS(mm_ice_prec) / dt IF (PRESENT(ccn_w)) ccn_w = mm_ccn_vsed(mm_nla:1:-1) IF (PRESENT(ccn_flux)) ccn_flux = mm_ccn_flux(mm_nla:1:-1)