- Timestamp:
- Aug 2, 2024, 2:12:03 PM (3 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90
r5099 r5158 200 200 logical, dimension(size(retrievedTau)) :: cloudMask 201 201 real, dimension(size(waterSize, 1), size(waterSize, 2)) :: tauLiquidFraction, tauTotal 202 real:: integratedLiquidFraction202 REAL :: integratedLiquidFraction 203 203 integer :: i, nSubcols, nLevels 204 204 … … 256 256 end if 257 257 258 doi = 1, nSubCols258 DO i = 1, nSubCols 259 259 if(cloudMask(i)) then 260 260 … … 371 371 liquid_opticalThickness, ice_opticalThickness, tauLiquidFraction 372 372 373 real:: seuil373 REAL :: seuil 374 374 ! --------------------------------------------------- 375 375 … … 596 596 reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask) 597 597 reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask) 598 doj=1,nPoints598 DO j=1,nPoints 599 599 600 600 ! Fill clear and optically thin subcolumns with fill … … 651 651 integer :: ij,ik 652 652 653 doij=2,nbin1+1654 doik=2,nbin2+1653 DO ij=2,nbin1+1 654 DO ik=2,nbin2+1 655 655 jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. & 656 656 var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik)) … … 778 778 ! Joint histogram 779 779 780 do i = 1, numTauHistogramBins780 DO i = 1, numTauHistogramBins 781 781 where(cloudMask(:, :)) 782 782 tauMask(:, :, i) = optical_thickness(:, :) >= tauHistogramBoundaries(i) .and. & … … 787 787 end do 788 788 789 do i = 1, numPressureHistogramBins789 DO i = 1, numPressureHistogramBins 790 790 where(cloudMask(:, :)) 791 791 pressureMask(:, :, i) = cloud_top_pressure(:, :) >= pressureHistogramBoundaries(i) .and. & … … 796 796 end do 797 797 798 doi = 1, numPressureHistogramBins799 doj = 1, numTauHistogramBins798 DO i = 1, numPressureHistogramBins 799 DO j = 1, numTauHistogramBins 800 800 Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = & 801 801 real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols) … … 808 808 real, dimension(:), intent(in) :: tauIncrement, pressure 809 809 real, intent(in) :: tauLimit 810 real:: cloud_top_pressure810 REAL :: cloud_top_pressure 811 811 812 812 ! Find the extinction-weighted pressure. Assume that pressure varies linearly between 813 813 ! layers and use the trapezoidal rule. 814 814 815 real:: deltaX, totalTau, totalProduct815 REAL :: deltaX, totalTau, totalProduct 816 816 integer :: i 817 817 818 818 totalTau = 0.; totalProduct = 0. 819 doi = 2, size(tauIncrement)819 DO i = 2, size(tauIncrement) 820 820 if(totalTau + tauIncrement(i) > tauLimit) then 821 821 deltaX = tauLimit - totalTau … … 840 840 real, dimension(:), intent(in) :: tauIncrement, f 841 841 real, intent(in) :: tauLimit 842 real:: weight_by_extinction842 REAL :: weight_by_extinction 843 843 844 844 ! Find the extinction-weighted value of f(tau), assuming constant f within each layer 845 845 846 real:: deltaX, totalTau, totalProduct846 REAL :: deltaX, totalTau, totalProduct 847 847 integer :: i 848 848 849 849 totalTau = 0.; totalProduct = 0. 850 doi = 1, size(tauIncrement)850 DO i = 1, size(tauIncrement) 851 851 if(totalTau + tauIncrement(i) > tauLimit) then 852 852 deltaX = tauLimit - totalTau … … 864 864 pure function compute_nir_reflectance(water_tau, water_size, ice_tau, ice_size) 865 865 real, dimension(:), intent(in) :: water_tau, water_size, ice_tau, ice_size 866 real:: compute_nir_reflectance866 REAL :: compute_nir_reflectance 867 867 868 868 real, dimension(size(water_tau)) :: water_g, water_w0, ice_g, ice_w0, & … … 893 893 integer, intent(in) :: phase 894 894 real, intent(in) :: tau, obs_Refl_nir 895 real:: retrieve_re895 REAL :: retrieve_re 896 896 897 897 ! Finds the re that produces the minimum mis-match between predicted and observed reflectance in … … 907 907 908 908 real, parameter :: min_distance_to_boundary = 0.01 909 real:: re_min, re_max, delta_re909 REAL :: re_min, re_max, delta_re 910 910 integer :: i 911 911 … … 957 957 real, dimension(:), intent(in) :: x, y 958 958 real, intent(in) :: yobs 959 real:: interpolate_to_min959 REAL :: interpolate_to_min 960 960 961 961 ! Given a set of values of y as y(x), find the value of x that minimizes abs(y - yobs) … … 1008 1008 integer, intent(in) :: phase 1009 1009 real, intent(in) :: re 1010 real :: get_g_nir1010 REAL :: get_g_nir 1011 1011 1012 1012 real, dimension(3), parameter :: ice_coefficients = (/ 0.7490, 6.5153e-3, -5.4136e-5 /), & … … 1035 1035 integer, intent(in) :: phase 1036 1036 real, intent(in) :: re 1037 real:: get_ssa_nir1037 REAL :: get_ssa_nir 1038 1038 1039 1039 ! Polynomial fit for single scattering albedo in MODIS band 7 (near IR) as a function … … 1060 1060 real, intent(in) :: x 1061 1061 real, dimension(:), intent(in) :: coefficients 1062 real:: fit_to_cubic1062 REAL :: fit_to_cubic 1063 1063 1064 1064 … … 1069 1069 real, intent(in) :: x 1070 1070 real, dimension(:), intent(in) :: coefficients 1071 real:: fit_to_quadratic1071 REAL :: fit_to_quadratic 1072 1072 1073 1073 … … 1079 1079 pure function compute_toa_reflectace(tau, g, w0) 1080 1080 real, dimension(:), intent(in) :: tau, g, w0 1081 real:: compute_toa_reflectace1081 REAL :: compute_toa_reflectace 1082 1082 1083 1083 logical, dimension(size(tau)) :: cloudMask 1084 1084 integer, dimension(count(tau(:) > 0)) :: cloudIndicies 1085 1085 real, dimension(count(tau(:) > 0)) :: Refl, Trans 1086 real:: Refl_tot, Trans_tot1086 REAL :: Refl_tot, Trans_tot 1087 1087 integer :: i 1088 1088 ! --------------------------------------- … … 1092 1092 cloudMask = tau(:) > 0. 1093 1093 cloudIndicies = pack((/ (i, i = 1, size(tau)) /), mask = cloudMask) 1094 doi = 1, size(cloudIndicies)1094 DO i = 1, size(cloudIndicies) 1095 1095 call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i)) 1096 1096 end do … … 1115 1115 integer, parameter :: beam = 2 1116 1116 real, parameter :: xmu = 0.866, minConservativeW0 = 0.9999999 1117 real:: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &1117 REAL :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, & 1118 1118 rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den, th 1119 1119 … … 1183 1183 elemental function two_stream_reflectance(tauint, gint, w0int) 1184 1184 real, intent(in) :: tauint, gint, w0int 1185 real:: two_stream_reflectance1185 REAL :: two_stream_reflectance 1186 1186 1187 1187 ! Compute reflectance in a single layer using the two stream approximation … … 1194 1194 integer, parameter :: beam = 2 1195 1195 real, parameter :: xmu = 0.866, minConservativeW0 = 0.9999999 1196 real:: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &1196 REAL :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, & 1197 1197 rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den 1198 1198 ! ------------------------ … … 1267 1267 Refl_cumulative(1) = Refl(1); Tran_cumulative(1) = Tran(1) 1268 1268 1269 doi=2, size(Refl)1269 DO i=2, size(Refl) 1270 1270 ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface): 1271 1271 Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1 - Refl_cumulative(i-1) * Refl(i))
Note: See TracChangeset
for help on using the changeset viewer.