| 1 | SUBROUTINE MACv2SP(pphis, pplay, paprs, xlon, xlat, tau_allaer, piz_allaer, cg_allaer) |
|---|
| 2 | |
|---|
| 3 | !--routine to read the MACv2SP plume and compute optical properties |
|---|
| 4 | !--requires flag_aerosol = 7 |
|---|
| 5 | !--feeds into aerosol optical properties and newmicro cloud droplet size if ok_cdnc activated |
|---|
| 6 | !--for this one needs to feed natural (pre-industrial) aerosols twice for nat and 1980 files |
|---|
| 7 | !--pre-ind aerosols (index=1) are not changed, present-day aerosols (index=2) are incremented |
|---|
| 8 | !--uses model year so year_cur needs to be correct in the model simulation |
|---|
| 9 | |
|---|
| 10 | !--aod_prof = AOD per layer |
|---|
| 11 | !--ssa_prof = SSA |
|---|
| 12 | !--asy_prof = asymetry parameter |
|---|
| 13 | !--dNovrN = enhancement factor for CDNC |
|---|
| 14 | |
|---|
| 15 | USE mo_simple_plumes, ONLY: sp_aop_profile |
|---|
| 16 | USE phys_cal_mod, ONLY: year_cur, day_cur, year_len |
|---|
| 17 | USE dimphy |
|---|
| 18 | USE aero_mod |
|---|
| 19 | USE phys_local_var_mod, ONLY: t_seri, od443aer, od550aer, od865aer, ec550aer, dryod550aer, od550lt1aer, dNovrN |
|---|
| 20 | !!USE YOMCST, ONLY: RD, RG |
|---|
| 21 | USE lmdz_abort_physic, ONLY: abort_physic |
|---|
| 22 | IMPLICIT NONE |
|---|
| 23 | |
|---|
| 24 | include "YOMCST.h" |
|---|
| 25 | |
|---|
| 26 | REAL, DIMENSION(klon), INTENT(IN) :: pphis ! Geopotentiel de surface |
|---|
| 27 | REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa) |
|---|
| 28 | REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs ! pression pour les interfaces de chaque couche (en Pa) |
|---|
| 29 | REAL, DIMENSION(klon), INTENT(IN) :: xlat ! latitudes pour chaque point |
|---|
| 30 | REAL, DIMENSION(klon), INTENT(IN) :: xlon ! longitudes pour chaque point |
|---|
| 31 | |
|---|
| 32 | REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: tau_allaer ! epaisseur optique aerosol |
|---|
| 33 | REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: piz_allaer ! single scattering albedo aerosol |
|---|
| 34 | REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: cg_allaer ! asymmetry parameter aerosol |
|---|
| 35 | |
|---|
| 36 | REAL, DIMENSION(klon, klev) :: aod_prof, ssa_prof, asy_prof |
|---|
| 37 | REAL, DIMENSION(klon, klev) :: z, dz |
|---|
| 38 | REAL, DIMENSION(klon) :: oro, zrho, zt |
|---|
| 39 | |
|---|
| 40 | INTEGER, PARAMETER :: nmon = 12 |
|---|
| 41 | |
|---|
| 42 | REAL, PARAMETER :: l443 = 443.0, l550 = 550.0, l865 = 865.0 !--wavelengths in nm |
|---|
| 43 | |
|---|
| 44 | INTEGER, PARAMETER :: Nwvmax = 25 |
|---|
| 45 | REAL, DIMENSION(0:Nwvmax), PARAMETER :: lambda = (/ 240.0, & !--this one is for band 1 |
|---|
| 46 | 280.0, 300.0, 330.0, 360.0, 400.0, & !--these are bounds of Streamer bands |
|---|
| 47 | 440.0, 480.0, 520.0, 570.0, 640.0, & |
|---|
| 48 | 690.0, 750.0, 780.0, 870.0, 1000.0, & |
|---|
| 49 | 1100.0, 1190.0, 1280.0, 1530.0, 1640.0, & |
|---|
| 50 | 2130.0, 2380.0, 2910.0, 3420.0, 4000.0 /) |
|---|
| 51 | |
|---|
| 52 | REAL, DIMENSION(1:Nwvmax - 1), PARAMETER :: weight = (/ & !--and the weights to be given to the bands |
|---|
| 53 | 0.01, 4.05, 9.51, 15.99, 26.07, 33.10, & !--corresponding to a typical solar spectrum |
|---|
| 54 | 33.07, 39.91, 52.67, 27.89, 43.60, 13.67, & |
|---|
| 55 | 42.22, 40.12, 32.70, 14.44, 19.48, 14.23, & |
|---|
| 56 | 13.43, 16.42, 8.33, 0.95, 0.65, 2.76 /) |
|---|
| 57 | |
|---|
| 58 | REAL :: zlambda, zweight |
|---|
| 59 | REAL :: year_fr |
|---|
| 60 | |
|---|
| 61 | INTEGER band, i, k, Nwv |
|---|
| 62 | |
|---|
| 63 | ! define the height and dheight arrays |
|---|
| 64 | |
|---|
| 65 | oro(:) = pphis(:) / RG ! surface height in m |
|---|
| 66 | |
|---|
| 67 | DO k = 1, klev |
|---|
| 68 | zrho(:) = pplay(:, k) / t_seri(:, k) / RD ! air density in kg/m3 |
|---|
| 69 | dz(:, k) = (paprs(:, k) - paprs(:, k + 1)) / zrho(:) / RG ! layer thickness in m |
|---|
| 70 | IF (k==1) THEN |
|---|
| 71 | z(:, 1) = oro(:) + (paprs(:, 1) - pplay(:, 1)) / zrho(:) / RG ! altitude middle of first layer in m |
|---|
| 72 | zt(:) = oro(:) + dz(:, 1) ! altitude top of first layer in m |
|---|
| 73 | ELSE |
|---|
| 74 | z(:, k) = zt(:) + (paprs(:, k) - pplay(:, k)) / zrho(:) / RG ! altitude middle of layer k in m |
|---|
| 75 | zt(:) = zt(:) + dz(:, k) ! altitude top of layer k in m |
|---|
| 76 | ENDIF |
|---|
| 77 | ENDDO |
|---|
| 78 | |
|---|
| 79 | !--fractional year |
|---|
| 80 | |
|---|
| 81 | year_fr = FLOAT(year_cur) + (FLOAT(day_cur) - 0.5) / FLOAT(year_len) |
|---|
| 82 | IF (year_fr<1850.0.OR.year_fr>=2017.0) THEN |
|---|
| 83 | CALL abort_physic ('macv2sp', 'year not supported by plume model', 1) |
|---|
| 84 | ENDIF |
|---|
| 85 | |
|---|
| 86 | !--CALL to sp routine -- 443 nm |
|---|
| 87 | |
|---|
| 88 | CALL sp_aop_profile (& |
|---|
| 89 | klev, klon, l443, oro, xlon, xlat, & |
|---|
| 90 | year_fr, z, dz, dNovrN, aod_prof, ssa_prof, & |
|---|
| 91 | asy_prof) |
|---|
| 92 | |
|---|
| 93 | !--AOD calculations for diagnostics |
|---|
| 94 | od443aer(:) = od443aer(:) + SUM(aod_prof(:, :), dim = 2) |
|---|
| 95 | |
|---|
| 96 | !--CALL to sp routine -- 550 nm |
|---|
| 97 | |
|---|
| 98 | CALL sp_aop_profile (& |
|---|
| 99 | klev, klon, l550, oro, xlon, xlat, & |
|---|
| 100 | year_fr, z, dz, dNovrN, aod_prof, ssa_prof, & |
|---|
| 101 | asy_prof) |
|---|
| 102 | |
|---|
| 103 | !--AOD calculations for diagnostics |
|---|
| 104 | od550aer(:) = od550aer(:) + SUM(aod_prof(:, :), dim = 2) |
|---|
| 105 | |
|---|
| 106 | !--dry AOD calculation for diagnostics |
|---|
| 107 | dryod550aer(:) = dryod550aer(:) + od550aer(:) |
|---|
| 108 | |
|---|
| 109 | !--fine-mode AOD calculation for diagnostics |
|---|
| 110 | od550lt1aer(:) = od550lt1aer(:) + od550aer(:) |
|---|
| 111 | |
|---|
| 112 | !--extinction coefficient for diagnostic |
|---|
| 113 | ec550aer(:, :) = ec550aer(:, :) + aod_prof(:, :) / dz(:, :) |
|---|
| 114 | |
|---|
| 115 | !--CALL to sp routine -- 865 nm |
|---|
| 116 | |
|---|
| 117 | CALL sp_aop_profile (& |
|---|
| 118 | klev, klon, l865, oro, xlon, xlat, & |
|---|
| 119 | year_fr, z, dz, dNovrN, aod_prof, ssa_prof, & |
|---|
| 120 | asy_prof) |
|---|
| 121 | |
|---|
| 122 | !--AOD calculations for diagnostics |
|---|
| 123 | od865aer(:) = od865aer(:) + SUM(aod_prof(:, :), dim = 2) |
|---|
| 124 | |
|---|
| 125 | !--re-weighting of piz and cg arrays before adding the anthropogenic aerosols |
|---|
| 126 | !--index 2 = all natural + anthropogenic aerosols |
|---|
| 127 | piz_allaer(:, :, 2, :) = piz_allaer(:, :, 2, :) * tau_allaer(:, :, 2, :) |
|---|
| 128 | cg_allaer(:, :, 2, :) = cg_allaer(:, :, 2, :) * piz_allaer(:, :, 2, :) |
|---|
| 129 | |
|---|
| 130 | !--now computing the same at many wavelengths to fill the model bands |
|---|
| 131 | |
|---|
| 132 | DO Nwv = 0, Nwvmax - 1 |
|---|
| 133 | |
|---|
| 134 | IF (Nwv==0) THEN !--RRTM spectral band 1 |
|---|
| 135 | zlambda = lambda(Nwv) |
|---|
| 136 | zweight = 1.0 |
|---|
| 137 | band = 1 |
|---|
| 138 | ELSEIF (Nwv<=5) THEN !--RRTM spectral band 2 |
|---|
| 139 | zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1)) |
|---|
| 140 | zweight = weight(Nwv) / SUM(weight(1:5)) |
|---|
| 141 | band = 2 |
|---|
| 142 | ELSEIF (Nwv<=10) THEN !--RRTM spectral band 3 |
|---|
| 143 | zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1)) |
|---|
| 144 | zweight = weight(Nwv) / SUM(weight(6:10)) |
|---|
| 145 | band = 3 |
|---|
| 146 | ELSEIF (Nwv<=16) THEN !--RRTM spectral band 4 |
|---|
| 147 | zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1)) |
|---|
| 148 | zweight = weight(Nwv) / SUM(weight(11:16)) |
|---|
| 149 | band = 4 |
|---|
| 150 | ELSEIF (Nwv<=21) THEN !--RRTM spectral band 5 |
|---|
| 151 | zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1)) |
|---|
| 152 | zweight = weight(Nwv) / SUM(weight(17:21)) |
|---|
| 153 | band = 5 |
|---|
| 154 | ELSE !--RRTM spectral band 6 |
|---|
| 155 | zlambda = 0.5 * (lambda(Nwv) + lambda(Nwv + 1)) |
|---|
| 156 | zweight = weight(Nwv) / SUM(weight(22:Nwvmax - 1)) |
|---|
| 157 | band = 6 |
|---|
| 158 | ENDIF |
|---|
| 159 | |
|---|
| 160 | CALL sp_aop_profile (& |
|---|
| 161 | klev, klon, zlambda, oro, xlon, xlat, & |
|---|
| 162 | year_fr, z, dz, dNovrN, aod_prof, ssa_prof, & |
|---|
| 163 | asy_prof) |
|---|
| 164 | |
|---|
| 165 | !--adding up the quantities tau, piz*tau and cg*piz*tau |
|---|
| 166 | tau_allaer(:, :, 2, band) = tau_allaer(:, :, 2, band) + zweight * MAX(aod_prof(:, :), 1.e-15) |
|---|
| 167 | piz_allaer(:, :, 2, band) = piz_allaer(:, :, 2, band) + zweight * MAX(aod_prof(:, :), 1.e-15) * ssa_prof(:, :) |
|---|
| 168 | cg_allaer(:, :, 2, band) = cg_allaer(:, :, 2, band) + zweight * MAX(aod_prof(:, :), 1.e-15) * ssa_prof(:, :) * asy_prof(:, :) |
|---|
| 169 | |
|---|
| 170 | ENDDO |
|---|
| 171 | |
|---|
| 172 | !--renpomalizing cg and piz now that MACv2SP increments have been added |
|---|
| 173 | cg_allaer(:, :, 2, :) = cg_allaer(:, :, 2, :) / piz_allaer(:, :, 2, :) |
|---|
| 174 | piz_allaer(:, :, 2, :) = piz_allaer(:, :, 2, :) / tau_allaer(:, :, 2, :) |
|---|
| 175 | |
|---|
| 176 | END SUBROUTINE MACv2SP |
|---|
