| Line |
Branch |
Exec |
Source |
| 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 |
|
|
! |
| 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.LT.1850.0.OR.year_fr.GE.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.EQ.0) THEN !--RRTM spectral band 1 |
| 135 |
|
✗ |
zlambda=lambda(Nwv) |
| 136 |
|
|
zweight=1.0 |
| 137 |
|
|
band=1 |
| 138 |
|
✗ |
ELSEIF (Nwv.LE.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.LE.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.LE.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.LE.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 |
| 177 |
|
|
|