source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/splaeropt_5wv_rrtm.f90 @ 5099

Last change on this file since 5099 was 5099, checked in by abarral, 2 months ago

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