| 1 | ! |
|---|
| 2 | ! $Id: splaeropt_5wv_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $ |
|---|
| 3 | ! |
|---|
| 4 | |
|---|
| 5 | SUBROUTINE SPLAEROPT_5WV_RRTM( & |
|---|
| 6 | zdm, zdh, tr_seri, RHcl, & |
|---|
| 7 | tausum, tau ) |
|---|
| 8 | |
|---|
| 9 | USE DIMPHY |
|---|
| 10 | USE aero_mod |
|---|
| 11 | USE infotrac_phy |
|---|
| 12 | USE phys_local_var_mod, ONLY: od550aer,od865aer,ec550aer,od550lt1aer |
|---|
| 13 | ! |
|---|
| 14 | ! Olivier Boucher Jan 2017 |
|---|
| 15 | ! Based on Mie routines on ciclad CMIP6 |
|---|
| 16 | ! |
|---|
| 17 | IMPLICIT NONE |
|---|
| 18 | ! |
|---|
| 19 | ! Input arguments: |
|---|
| 20 | ! |
|---|
| 21 | REAL, DIMENSION(klon,klev), INTENT(IN) :: zdh !--m |
|---|
| 22 | REAL, DIMENSION(klon,klev), INTENT(IN) :: zdm !--kg/m2 |
|---|
| 23 | REAL, DIMENSION(klon,klev), INTENT(IN) :: RHcl ! humidite relative ciel clair |
|---|
| 24 | REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri |
|---|
| 25 | ! |
|---|
| 26 | ! Output arguments: |
|---|
| 27 | ! |
|---|
| 28 | REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT) :: tausum |
|---|
| 29 | REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau |
|---|
| 30 | ! |
|---|
| 31 | ! Local |
|---|
| 32 | ! |
|---|
| 33 | INTEGER, PARAMETER :: las = nwave_sw |
|---|
| 34 | LOGICAL :: soluble |
|---|
| 35 | |
|---|
| 36 | INTEGER :: i, k, m, itr, irh, aerindex |
|---|
| 37 | INTEGER :: spsol, spinsol, la |
|---|
| 38 | INTEGER :: RH_num(klon,klev) |
|---|
| 39 | INTEGER, PARAMETER :: la443 = 1 |
|---|
| 40 | INTEGER, PARAMETER :: la550 = 2 |
|---|
| 41 | INTEGER, PARAMETER :: la670 = 3 |
|---|
| 42 | INTEGER, PARAMETER :: la765 = 4 |
|---|
| 43 | INTEGER, PARAMETER :: la865 = 5 |
|---|
| 44 | INTEGER, PARAMETER :: nbre_RH=12 |
|---|
| 45 | INTEGER, PARAMETER :: naero_soluble=2 |
|---|
| 46 | INTEGER, PARAMETER :: naero_insoluble=2 |
|---|
| 47 | INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble |
|---|
| 48 | |
|---|
| 49 | REAL, PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./) |
|---|
| 50 | REAL, PARAMETER :: RH_MAX=95. |
|---|
| 51 | REAL :: delta(klon,klev), rh(klon,klev) |
|---|
| 52 | REAL :: tau_ae5wv_int ! Intermediate computation of epaisseur optique aerosol |
|---|
| 53 | REAL :: zrho |
|---|
| 54 | CHARACTER*20 modname |
|---|
| 55 | |
|---|
| 56 | ! Soluble components 1-accumulation mode soluble; 2- seasalt coarse |
|---|
| 57 | REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble) ! Ext. coeff. ** m2/g |
|---|
| 58 | ! Insoluble components 1- Dust: 2- BC; 3- POM |
|---|
| 59 | REAL :: alpha_aeri_5wv(las,naero_insoluble) ! Ext. coeff. ** m2/g |
|---|
| 60 | ! |
|---|
| 61 | ! Proprietes optiques |
|---|
| 62 | ! |
|---|
| 63 | REAL :: fact_RH(nbre_RH) |
|---|
| 64 | |
|---|
| 65 | ! From here on we look at the optical parameters at 5 wavelengths: |
|---|
| 66 | ! 443nm, 550, 670, 765 and 865 nm |
|---|
| 67 | ! le 12 AVRIL 2006 |
|---|
| 68 | ! |
|---|
| 69 | DATA alpha_aers_5wv/ & |
|---|
| 70 | ! accumulation mode (sulfate+2% bc) soluble |
|---|
| 71 | 4.632, 4.632, 4.632, 4.632, 6.206, 6.827, 7.616, 8.716,10.514,12.025,14.688,21.539, & |
|---|
| 72 | 3.981, 3.981, 3.981, 3.981, 5.346, 5.923, 6.662, 7.704, 9.437,10.914,13.562,20.591, & |
|---|
| 73 | 3.265, 3.265, 3.265, 3.265, 4.400, 4.909, 5.565, 6.500, 8.081, 9.449,11.943,18.791, & |
|---|
| 74 | 2.761, 2.761, 2.761, 2.761, 3.731, 4.182, 4.767, 5.606, 7.041, 8.294,10.610,17.118, & |
|---|
| 75 | 2.307, 2.307, 2.307, 2.307, 3.129, 3.522, 4.034, 4.774, 6.052, 7.180, 9.286,15.340, & |
|---|
| 76 | |
|---|
| 77 | ! seasalt seasalt Coarse Soluble (CS) |
|---|
| 78 | 0.576, 0.690, 0.738, 0.789, 0.855, 0.935, 1.046, 1.212, 1.512, 1.785, 2.258, 3.449, & |
|---|
| 79 | 0.595, 0.713, 0.763, 0.814, 0.880, 0.963, 1.079, 1.248, 1.550, 1.826, 2.306, 3.507, & |
|---|
| 80 | 0.617, 0.738, 0.789, 0.842, 0.911, 0.996, 1.113, 1.286, 1.592, 1.871, 2.369, 3.562, & |
|---|
| 81 | 0.632, 0.755, 0.808, 0.862, 0.931, 1.018, 1.140, 1.316, 1.626, 1.909, 2.409, 3.622, & |
|---|
| 82 | 0.645, 0.771, 0.825, 0.880, 0.951, 1.039, 1.164, 1.344, 1.661, 1.948, 2.455, 3.682 / |
|---|
| 83 | |
|---|
| 84 | DATA alpha_aeri_5wv/ & |
|---|
| 85 | ! coarse dust insoluble |
|---|
| 86 | 0.605, 0.611, 0.661, 0.714, 0.760, & |
|---|
| 87 | ! super coarse insoluble |
|---|
| 88 | 0.153, 0.156, 0.158, 0.157, 0.161 / |
|---|
| 89 | ! |
|---|
| 90 | ! Initialisations |
|---|
| 91 | tausum(:,:,:)=0. |
|---|
| 92 | tau(:,:,:,:)=0. |
|---|
| 93 | |
|---|
| 94 | modname='splaeropt_5wv_rrtm' |
|---|
| 95 | |
|---|
| 96 | IF (naero.GT.naero_tot) THEN |
|---|
| 97 | CALL abort_physic(modname,'Too many aerosol types',1) |
|---|
| 98 | ENDIF |
|---|
| 99 | |
|---|
| 100 | DO irh=1,nbre_RH-1 |
|---|
| 101 | fact_RH(irh)=1./(RH_tab(irh+1)-RH_tab(irh)) |
|---|
| 102 | ENDDO |
|---|
| 103 | |
|---|
| 104 | DO k=1, klev |
|---|
| 105 | DO i=1, klon |
|---|
| 106 | rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX) |
|---|
| 107 | RH_num(i,k) = INT( rh(i,k)/10. + 1.) |
|---|
| 108 | IF (rh(i,k).GT.85.) RH_num(i,k)=10 |
|---|
| 109 | IF (rh(i,k).GT.90.) RH_num(i,k)=11 |
|---|
| 110 | delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k)) |
|---|
| 111 | ENDDO |
|---|
| 112 | ENDDO |
|---|
| 113 | |
|---|
| 114 | DO itr=1,nbtr !--loop over tracers |
|---|
| 115 | |
|---|
| 116 | IF (tname(itr+nqo)=='PREC') THEN !--fine mode accumulation mode |
|---|
| 117 | CYCLE |
|---|
| 118 | ELSE IF (tname(itr+nqo)=='FINE') THEN !--fine mode accumulation mode |
|---|
| 119 | soluble=.TRUE. |
|---|
| 120 | spsol=1 |
|---|
| 121 | aerindex=1 |
|---|
| 122 | ELSE IF (tname(itr+nqo)=='COSS') THEN !--coarse mode sea salt |
|---|
| 123 | soluble=.TRUE. |
|---|
| 124 | spsol=2 |
|---|
| 125 | aerindex=2 |
|---|
| 126 | ELSE IF (tname(itr+nqo)=='CODU') THEN !--coarse mode dust |
|---|
| 127 | soluble=.FALSE. |
|---|
| 128 | spinsol=1 |
|---|
| 129 | aerindex=3 |
|---|
| 130 | ELSE IF (tname(itr+nqo)=='SCDU') THEN !--super coarse mode dust |
|---|
| 131 | soluble=.FALSE. |
|---|
| 132 | spinsol=2 |
|---|
| 133 | aerindex=4 |
|---|
| 134 | ELSE |
|---|
| 135 | CALL abort_physic(modname,'I cannot do aerosol optics for '//tname(itr+nqo),1) |
|---|
| 136 | ENDIF |
|---|
| 137 | |
|---|
| 138 | DO la=1,las |
|---|
| 139 | |
|---|
| 140 | !--only 550 and 865 nm are used |
|---|
| 141 | IF (la.NE.la550.AND.la.NE.la865) CYCLE |
|---|
| 142 | |
|---|
| 143 | IF (soluble) THEN !--soluble aerosol with RH dependence |
|---|
| 144 | |
|---|
| 145 | DO k=1, klev |
|---|
| 146 | DO i=1, klon |
|---|
| 147 | tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* & |
|---|
| 148 | (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - & |
|---|
| 149 | alpha_aers_5wv(RH_num(i,k),la,spsol)) |
|---|
| 150 | tau(i,k,la,aerindex) = tr_seri(i,k,itr)*zdm(i,k)*tau_ae5wv_int |
|---|
| 151 | tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) |
|---|
| 152 | ENDDO |
|---|
| 153 | ENDDO |
|---|
| 154 | |
|---|
| 155 | ELSE !--cases of insoluble aerosol |
|---|
| 156 | |
|---|
| 157 | DO k=1, klev |
|---|
| 158 | DO i=1, klon |
|---|
| 159 | tau_ae5wv_int = alpha_aeri_5wv(la,spinsol) |
|---|
| 160 | tau(i,k,la,aerindex) = tr_seri(i,k,itr)*zdm(i,k)*tau_ae5wv_int |
|---|
| 161 | tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex) |
|---|
| 162 | ENDDO |
|---|
| 163 | ENDDO |
|---|
| 164 | |
|---|
| 165 | ENDIF |
|---|
| 166 | |
|---|
| 167 | ENDDO ! Boucle sur les longueurs d'onde |
|---|
| 168 | ENDDO ! Boucle sur les masses de traceurs |
|---|
| 169 | |
|---|
| 170 | !--AOD calculations for diagnostics |
|---|
| 171 | od550aer(:)=SUM(tausum(:,la550,1:naero),dim=2) |
|---|
| 172 | od865aer(:)=SUM(tausum(:,la865,1:naero),dim=2) |
|---|
| 173 | |
|---|
| 174 | !--extinction coefficient for diagnostic |
|---|
| 175 | ec550aer(:,:)=SUM(tau(:,:,la550,1:naero),dim=3)/zdh(:,:) |
|---|
| 176 | |
|---|
| 177 | !--aod for particles lower than 1 micron |
|---|
| 178 | od550lt1aer(:)=tausum(:,la550,1)+tausum(:,la550,2)*0.3+tausum(:,la550,3)*0.2 |
|---|
| 179 | |
|---|
| 180 | END SUBROUTINE SPLAEROPT_5WV_RRTM |
|---|
