1 | ! radiation_ice_optics_baran2016.F90 - Baran et al. (2016) scheme for ice optical properties |
---|
2 | ! |
---|
3 | ! (C) Copyright 2016- ECMWF. |
---|
4 | ! |
---|
5 | ! This software is licensed under the terms of the Apache Licence Version 2.0 |
---|
6 | ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. |
---|
7 | ! |
---|
8 | ! In applying this licence, ECMWF does not waive the privileges and immunities |
---|
9 | ! granted to it by virtue of its status as an intergovernmental organisation |
---|
10 | ! nor does it submit to any jurisdiction. |
---|
11 | ! |
---|
12 | ! Author: Robin Hogan |
---|
13 | ! Email: r.j.hogan@ecmwf.int |
---|
14 | ! |
---|
15 | |
---|
16 | module radiation_ice_optics_baran2016 |
---|
17 | |
---|
18 | implicit none |
---|
19 | |
---|
20 | ! The number of ice coefficients depends on the parameterization |
---|
21 | integer, parameter :: NIceOpticsCoeffsBaran2016 = 5 |
---|
22 | |
---|
23 | contains |
---|
24 | |
---|
25 | |
---|
26 | !--------------------------------------------------------------------- |
---|
27 | ! Compute ice-particle scattering properties using a |
---|
28 | ! parameterization as a function of ice water mixing ratio and |
---|
29 | ! temperature |
---|
30 | subroutine calc_ice_optics_baran2016(nb, coeff, ice_wp, & |
---|
31 | & qi, temperature, od, scat_od, g) |
---|
32 | |
---|
33 | use parkind1, only : jprb |
---|
34 | !use yomhook, only : lhook, dr_hook |
---|
35 | |
---|
36 | ! Number of bands |
---|
37 | integer, intent(in) :: nb |
---|
38 | ! Coefficients read from a data file |
---|
39 | real(jprb), intent(in) :: coeff(:,:) |
---|
40 | ! Ice water path (kg m-2) and mixing ratio (kg kg-1) |
---|
41 | real(jprb), intent(in) :: ice_wp, qi |
---|
42 | ! Temperature (K) |
---|
43 | real(jprb), intent(in) :: temperature |
---|
44 | ! Total optical depth, scattering optical depth and asymmetry factor |
---|
45 | real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb) |
---|
46 | |
---|
47 | ! Powers of temperature, some multiplied by qi |
---|
48 | real(jprb) :: qi_T, T2, qi_over_T4 |
---|
49 | |
---|
50 | !real(jprb) :: hook_handle |
---|
51 | |
---|
52 | !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2016',0,hook_handle) |
---|
53 | |
---|
54 | T2 = temperature * temperature |
---|
55 | |
---|
56 | if (qi < 1.0e-3_jprb) then |
---|
57 | qi_T = qi * temperature |
---|
58 | qi_over_T4 = 1.0_jprb / (T2 * T2) |
---|
59 | else |
---|
60 | qi_T = 1.0e-3_jprb * temperature |
---|
61 | qi_over_T4 = 1.0_jprb / (T2 * T2) |
---|
62 | end if |
---|
63 | |
---|
64 | od = ice_wp * coeff(1:nb,1) * qi_over_T4 |
---|
65 | scat_od = od * (coeff(1:nb,2) + coeff(1:nb,3) * qi_T) |
---|
66 | g = coeff(1:nb,4) + coeff(1:nb,5) * qi_T |
---|
67 | |
---|
68 | !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_baran2016',1,hook_handle) |
---|
69 | |
---|
70 | end subroutine calc_ice_optics_baran2016 |
---|
71 | |
---|
72 | end module radiation_ice_optics_baran2016 |
---|