source: LMDZ6/branches/Amaury_dev/libf/phylmd/macv2sp.F90 @ 5153

SUBROUTINE MACv2SP(pphis, pplay, paprs, xlon, xlat, tau_allaer, piz_allaer, cg_allaer)

  !--routine to read the MACv2SP plume and compute optical properties
  !--requires flag_aerosol = 7
  !--feeds into aerosol optical properties and newmicro cloud droplet size if ok_cdnc activated
  !--for this one needs to feed natural (pre-industrial) aerosols twice for nat and 1980 files
  !--pre-ind aerosols (index=1) are not changed, present-day aerosols (index=2) are incremented
  !--uses model year so year_cur needs to be correct in the model simulation

  !--aod_prof = AOD per layer 
  !--ssa_prof = SSA 
  !--asy_prof = asymetry parameter
  !--dNovrN   = enhancement factor for CDNC

  USE mo_simple_plumes, ONLY: sp_aop_profile
  USE phys_cal_mod, ONLY: year_cur, day_cur, year_len
  USE dimphy
  USE aero_mod
  USE phys_local_var_mod, ONLY: t_seri, od443aer, od550aer, od865aer, ec550aer, dryod550aer, od550lt1aer, dNovrN
  !!USE YOMCST, ONLY: RD, RG
  USE lmdz_abort_physic, ONLY: abort_physic
  USE lmdz_yomcst

  IMPLICIT NONE

  REAL, DIMENSION(klon), INTENT(IN) :: pphis   ! Geopotentiel de surface
  REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay   ! pression pour le mileu de chaque couche (en Pa)
  REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs   ! pression pour les interfaces de chaque couche (en Pa)
  REAL, DIMENSION(klon), INTENT(IN) :: xlat    ! latitudes pour chaque point
  REAL, DIMENSION(klon), INTENT(IN) :: xlon    ! longitudes pour chaque point

  REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: tau_allaer !  epaisseur optique aerosol
  REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: piz_allaer !  single scattering albedo aerosol
  REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: cg_allaer  !  asymmetry parameter aerosol

  REAL, DIMENSION(klon, klev) :: aod_prof, ssa_prof, asy_prof
  REAL, DIMENSION(klon, klev) :: z, dz
  REAL, DIMENSION(klon) :: oro, zrho, zt

  INTEGER, PARAMETER :: nmon = 12

  REAL, PARAMETER :: l443 = 443.0, l550 = 550.0, l865 = 865.0 !--wavelengths in nm

  INTEGER, PARAMETER :: Nwvmax = 25
  REAL, DIMENSION(0:Nwvmax), PARAMETER :: lambda = (/ 240.0, &  !--this one is for band 1
          280.0, 300.0, 330.0, 360.0, 400.0, &  !--these are bounds of Streamer bands
          440.0, 480.0, 520.0, 570.0, 640.0, &
          690.0, 750.0, 780.0, 870.0, 1000.0, &
          1100.0, 1190.0, 1280.0, 1530.0, 1640.0, &
          2130.0, 2380.0, 2910.0, 3420.0, 4000.0   /)

  REAL, DIMENSION(1:Nwvmax - 1), PARAMETER :: weight = (/    &   !--and the weights to be given to the bands
          0.01, 4.05, 9.51, 15.99, 26.07, 33.10, &   !--corresponding to a typical solar spectrum
                  33.07, 39.91, 52.67, 27.89, 43.60, 13.67, &
                  42.22, 40.12, 32.70, 14.44, 19.48, 14.23, &
                  13.43, 16.42, 8.33, 0.95, 0.65, 2.76  /)

  REAL :: zlambda, zweight
  REAL :: year_fr

  INTEGER band, i, k, Nwv

  ! define the height and dheight arrays

  oro(:) = pphis(:) / RG                             ! surface height in m

  DO k = 1, klev
    zrho(:) = pplay(:, k) / t_seri(:, k) / RD                         ! air density in kg/m3
    dz(:, k) = (paprs(:, k) - paprs(:, k + 1)) / zrho(:) / RG              ! layer thickness in m
    IF (k==1) THEN
      z(:, 1) = oro(:) + (paprs(:, 1) - pplay(:, 1)) / zrho(:) / RG     ! altitude middle of first layer in m
      zt(:) = oro(:) + dz(:, 1)                                ! altitude top of first layer in m
    ELSE
      z(:, k) = zt(:) + (paprs(:, k) - pplay(:, k)) / zrho(:) / RG       ! altitude middle of layer k in m
      zt(:) = zt(:) + dz(:, k)                                  ! altitude top of layer k in m
    ENDIF
  ENDDO

  !--fractional year

  year_fr = FLOAT(year_cur) + (FLOAT(day_cur) - 0.5) / FLOAT(year_len)
  IF (year_fr<1850.0.OR.year_fr>=2017.0) THEN
    CALL abort_physic ('macv2sp', 'year not supported by plume model', 1)
  ENDIF

  !--CALL to sp routine -- 443 nm

  CALL sp_aop_profile                                    (&
          klev, klon, l443, oro, xlon, xlat, &
          year_fr, z, dz, dNovrN, aod_prof, ssa_prof, &
          asy_prof)

  !--AOD calculations for diagnostics
  od443aer(:) = od443aer(:) + SUM(aod_prof(:, :), dim = 2)

  !--CALL to sp routine -- 550 nm

  CALL sp_aop_profile                                    (&
          klev, klon, l550, oro, xlon, xlat, &
          year_fr, z, dz, dNovrN, aod_prof, ssa_prof, &
          asy_prof)

  !--AOD calculations for diagnostics
  od550aer(:) = od550aer(:) + SUM(aod_prof(:, :), dim = 2)

  !--dry AOD calculation for diagnostics
  dryod550aer(:) = dryod550aer(:) + od550aer(:)

  !--fine-mode AOD calculation for diagnostics
  od550lt1aer(:) = od550lt1aer(:) + od550aer(:)

  !--extinction coefficient for diagnostic
  ec550aer(:, :) = ec550aer(:, :) + aod_prof(:, :) / dz(:, :)

  !--CALL to sp routine -- 865 nm

  CALL sp_aop_profile                                    (&
          klev, klon, l865, oro, xlon, xlat, &
          year_fr, z, dz, dNovrN, aod_prof, ssa_prof, &
          asy_prof)

  !--AOD calculations for diagnostics
  od865aer(:) = od865aer(:) + SUM(aod_prof(:, :), dim = 2)

  !--re-weighting of piz and cg arrays before adding the anthropogenic aerosols
  !--index 2 = all natural + anthropogenic aerosols
  piz_allaer(:, :, 2, :) = piz_allaer(:, :, 2, :) * tau_allaer(:, :, 2, :)
  cg_allaer(:, :, 2, :) = cg_allaer(:, :, 2, :) * piz_allaer(:, :, 2, :)

  !--now computing the same at many wavelengths to fill the model bands

  DO Nwv = 0, Nwvmax - 1

    IF (Nwv==0) THEN          !--RRTM spectral band 1
      zlambda = lambda(Nwv)
      zweight = 1.0
      band = 1
    ELSEIF (Nwv<=5) THEN      !--RRTM spectral band 2
      zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1))
      zweight = weight(Nwv) / SUM(weight(1:5))
      band = 2
    ELSEIF (Nwv<=10) THEN     !--RRTM spectral band 3
      zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1))
      zweight = weight(Nwv) / SUM(weight(6:10))
      band = 3
    ELSEIF (Nwv<=16) THEN     !--RRTM spectral band 4
      zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1))
      zweight = weight(Nwv) / SUM(weight(11:16))
      band = 4
    ELSEIF (Nwv<=21) THEN     !--RRTM spectral band 5
      zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1))
      zweight = weight(Nwv) / SUM(weight(17:21))
      band = 5
    ELSE                        !--RRTM spectral band 6
      zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1))
      zweight = weight(Nwv) / SUM(weight(22:Nwvmax - 1))
      band = 6
    ENDIF

    CALL sp_aop_profile                                       (&
            klev, klon, zlambda, oro, xlon, xlat, &
            year_fr, z, dz, dNovrN, aod_prof, ssa_prof, &
            asy_prof)

    !--adding up the quantities tau, piz*tau and cg*piz*tau
    tau_allaer(:, :, 2, band) = tau_allaer(:, :, 2, band) + zweight * MAX(aod_prof(:, :), 1.e-15)
    piz_allaer(:, :, 2, band) = piz_allaer(:, :, 2, band) + zweight * MAX(aod_prof(:, :), 1.e-15) * ssa_prof(:, :)
    cg_allaer(:, :, 2, band) = cg_allaer(:, :, 2, band) + zweight * MAX(aod_prof(:, :), 1.e-15) * ssa_prof(:, :) * asy_prof(:, :)

  ENDDO

  !--renpomalizing cg and piz now that MACv2SP increments have been added
  cg_allaer(:, :, 2, :) = cg_allaer(:, :, 2, :) / piz_allaer(:, :, 2, :)
  piz_allaer(:, :, 2, :) = piz_allaer(:, :, 2, :) / tau_allaer(:, :, 2, :)

END SUBROUTINE MACv2SP