Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (3 months ago)
Author:
abarral
Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90

    r5099 r5158  
    200200    logical, dimension(size(retrievedTau))                     :: cloudMask
    201201    real,    dimension(size(waterSize, 1), size(waterSize, 2)) :: tauLiquidFraction, tauTotal
    202     real    :: integratedLiquidFraction
     202    REAL    :: integratedLiquidFraction
    203203    integer :: i, nSubcols, nLevels
    204204
     
    256256    end if
    257257   
    258     do i = 1, nSubCols
     258    DO i = 1, nSubCols
    259259      if(cloudMask(i)) then
    260260
     
    371371           liquid_opticalThickness, ice_opticalThickness, tauLiquidFraction
    372372   
    373     real :: seuil
     373    REAL :: seuil
    374374    ! ---------------------------------------------------
    375375   
     
    596596    reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask)
    597597    reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask)
    598     do j=1,nPoints
     598    DO j=1,nPoints
    599599
    600600       ! Fill clear and optically thin subcolumns with fill
     
    651651    integer :: ij,ik
    652652   
    653     do ij=2,nbin1+1
    654        do ik=2,nbin2+1
     653    DO ij=2,nbin1+1
     654       DO ik=2,nbin2+1
    655655          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
    656656               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       
     
    778778    ! Joint histogram
    779779
    780     do i = 1, numTauHistogramBins
     780    DO i = 1, numTauHistogramBins
    781781      where(cloudMask(:, :))
    782782        tauMask(:, :, i) = optical_thickness(:, :) >= tauHistogramBoundaries(i) .and. &
     
    787787    end do
    788788
    789     do i = 1, numPressureHistogramBins
     789    DO i = 1, numPressureHistogramBins
    790790      where(cloudMask(:, :))
    791791        pressureMask(:, :, i) = cloud_top_pressure(:, :) >= pressureHistogramBoundaries(i) .and. &
     
    796796    end do
    797797   
    798     do i = 1, numPressureHistogramBins
    799       do j = 1, numTauHistogramBins
     798    DO i = 1, numPressureHistogramBins
     799      DO j = 1, numTauHistogramBins
    800800        Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = &
    801801          real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
     
    808808    real, dimension(:), intent(in) :: tauIncrement, pressure
    809809    real,               intent(in) :: tauLimit
    810     real                           :: cloud_top_pressure
     810    REAL                           :: cloud_top_pressure
    811811
    812812    ! Find the extinction-weighted pressure. Assume that pressure varies linearly between
    813813    !   layers and use the trapezoidal rule.
    814814
    815     real :: deltaX, totalTau, totalProduct
     815    REAL :: deltaX, totalTau, totalProduct
    816816    integer :: i
    817817   
    818818    totalTau = 0.; totalProduct = 0.
    819     do i = 2, size(tauIncrement)
     819    DO i = 2, size(tauIncrement)
    820820      if(totalTau + tauIncrement(i) > tauLimit) then
    821821        deltaX = tauLimit - totalTau
     
    840840    real, dimension(:), intent(in) :: tauIncrement, f
    841841    real,               intent(in) :: tauLimit
    842     real                           :: weight_by_extinction
     842    REAL                           :: weight_by_extinction
    843843
    844844    ! Find the extinction-weighted value of f(tau), assuming constant f within each layer
    845845
    846     real    :: deltaX, totalTau, totalProduct
     846    REAL    :: deltaX, totalTau, totalProduct
    847847    integer :: i
    848848   
    849849    totalTau = 0.; totalProduct = 0.
    850     do i = 1, size(tauIncrement)
     850    DO i = 1, size(tauIncrement)
    851851      if(totalTau + tauIncrement(i) > tauLimit) then
    852852        deltaX       = tauLimit - totalTau
     
    864864  pure function compute_nir_reflectance(water_tau, water_size, ice_tau, ice_size)
    865865    real, dimension(:), intent(in) :: water_tau, water_size, ice_tau, ice_size
    866     real                           :: compute_nir_reflectance
     866    REAL                           :: compute_nir_reflectance
    867867   
    868868    real, dimension(size(water_tau)) :: water_g, water_w0, ice_g, ice_w0, &
     
    893893      integer, intent(in) :: phase
    894894      real,    intent(in) :: tau, obs_Refl_nir
    895       real                :: retrieve_re
     895      REAL                :: retrieve_re
    896896
    897897      ! Finds the re that produces the minimum mis-match between predicted and observed reflectance in
     
    907907
    908908      real, parameter :: min_distance_to_boundary = 0.01
    909       real    :: re_min, re_max, delta_re
     909      REAL    :: re_min, re_max, delta_re
    910910      integer :: i
    911911     
     
    957957    real, dimension(:), intent(in) :: x, y
    958958    real,               intent(in) :: yobs
    959     real                           :: interpolate_to_min
     959    REAL                           :: interpolate_to_min
    960960
    961961    ! Given a set of values of y as y(x), find the value of x that minimizes abs(y - yobs)
     
    10081008    integer, intent(in) :: phase
    10091009    real,    intent(in) :: re
    1010     real :: get_g_nir
     1010    REAL :: get_g_nir
    10111011
    10121012    real, dimension(3), parameter :: ice_coefficients         = (/ 0.7490, 6.5153e-3, -5.4136e-5 /), &
     
    10351035        integer, intent(in) :: phase
    10361036        real,    intent(in) :: re
    1037         real                :: get_ssa_nir
     1037        REAL                :: get_ssa_nir
    10381038
    10391039        ! Polynomial fit for single scattering albedo in MODIS band 7 (near IR) as a function
     
    10601060    real,               intent(in) :: x
    10611061    real, dimension(:), intent(in) :: coefficients
    1062     real                           :: fit_to_cubic
     1062    REAL                           :: fit_to_cubic
    10631063   
    10641064   
     
    10691069    real,               intent(in) :: x
    10701070    real, dimension(:), intent(in) :: coefficients
    1071     real                           :: fit_to_quadratic
     1071    REAL                           :: fit_to_quadratic
    10721072   
    10731073   
     
    10791079  pure function compute_toa_reflectace(tau, g, w0)
    10801080    real, dimension(:), intent(in) :: tau, g, w0
    1081     real                           :: compute_toa_reflectace
     1081    REAL                           :: compute_toa_reflectace
    10821082   
    10831083    logical, dimension(size(tau))         :: cloudMask
    10841084    integer, dimension(count(tau(:) > 0)) :: cloudIndicies
    10851085    real,    dimension(count(tau(:) > 0)) :: Refl,     Trans
    1086     real                                  :: Refl_tot, Trans_tot
     1086    REAL                                  :: Refl_tot, Trans_tot
    10871087    integer                               :: i
    10881088    ! ---------------------------------------
     
    10921092    cloudMask = tau(:) > 0.
    10931093    cloudIndicies = pack((/ (i, i = 1, size(tau)) /), mask = cloudMask)
    1094     do i = 1, size(cloudIndicies)
     1094    DO i = 1, size(cloudIndicies)
    10951095      call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    10961096    end do
     
    11151115    integer, parameter :: beam = 2
    11161116    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, &
    11181118            rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den, th
    11191119
     
    11831183  elemental function two_stream_reflectance(tauint, gint, w0int)
    11841184    real, intent(in) :: tauint, gint, w0int
    1185     real             :: two_stream_reflectance
     1185    REAL             :: two_stream_reflectance
    11861186
    11871187    ! Compute reflectance in a single layer using the two stream approximation
     
    11941194    integer, parameter :: beam = 2
    11951195    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, &
    11971197            rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den
    11981198    ! ------------------------
     
    12671267      Refl_cumulative(1) = Refl(1); Tran_cumulative(1) = Tran(1)   
    12681268     
    1269       do i=2, size(Refl)
     1269      DO i=2, size(Refl)
    12701270          ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface):
    12711271          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.