source: LMDZ6/trunk/libf/phylmd/ecrad/radiation_ice_optics_yi.F90 @ 4629

Last change on this file since 4629 was 3908, checked in by idelkadi, 3 years ago

Online implementation of the radiative transfer code ECRAD in the LMDZ model.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
    • interface routine : radiation_scheme.F90
  • Adaptation of compilation scripts :
    • compilation under CPP key CPP_ECRAD
    • compilation with option "-rad ecard" or "-ecard true"
    • The "-rad old/rtm/ecran" build option will need to replace the "-rrtm true" and "-ecrad true" options in the future.
  • Runing LMDZ simulations with ecrad, you need :
    • logical key iflag_rrtm = 2 in physiq.def
    • namelist_ecrad (DefLists?)
    • the directory "data" containing the configuration files is temporarily placed in ../libfphylmd/ecrad/
  • Compilation and execution are tested in the 1D case. The repository under svn would allow to continue the implementation work: tests, verification of the results, ...
File size: 5.3 KB
Line 
1! radiation_ice_optics_yi.F90 - Yi et al. (2013) ice optical properties
2!
3! (C) Copyright 2017- 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! Authors: Mark Fielding and Robin Hogan
13! Email:   r.j.hogan@ecmwf.int
14!
15! The reference for this ice optics parameterization is Yi, B.,
16! P. Yang, B.A. Baum, T. L'Ecuyer, L. Oreopoulos, E.J. Mlawer,
17! A.J. Heymsfield, and K. Liou, 2013: Influence of Ice Particle
18! Surface Roughening on the Global Cloud Radiative
19! Effect. J. Atmos. Sci., 70, 2794–2807,
20! https://doi.org/10.1175/JAS-D-13-020.1
21
22module radiation_ice_optics_yi
23
24  implicit none
25  public
26
27  ! The number of ice coefficients depends on the parameterization
28  integer, parameter :: NIceOpticsCoeffsYiSW  = 69
29  integer, parameter :: NIceOpticsCoeffsYiLW  = 69
30
31  integer, parameter :: NSingleCoeffs = 23
32
33contains
34
35  !---------------------------------------------------------------------
36  ! Compute shortwave ice-particle scattering properties using Yi et
37  ! al. (2013) parameterization
38  subroutine calc_ice_optics_yi_sw(nb, coeff, ice_wp, &
39       &  re, od, scat_od, g)
40
41    use parkind1, only : jprb, jpim
42    !use yomhook,  only : lhook, dr_hook
43
44    ! Number of bands
45    integer, intent(in)  :: nb
46    ! Coefficients read from a data file
47    real(jprb), intent(in) :: coeff(:,:)
48    ! Ice water path (kg m-2)
49    real(jprb), intent(in) :: ice_wp
50    ! Effective radius (m)
51    real(jprb), intent(in) :: re
52    ! Total optical depth, scattering optical depth and asymmetry factor
53    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
54
55    ! Yi's effective diameter (microns)
56    real(jprb) :: de_um
57    ! Ice water path in g m-2
58    real (jprb) :: iwp_gm_2
59    ! LUT temp variables
60    real(jprb) :: wts_1, wts_2
61    integer(jpim) :: lu_idx
62    real(kind=jprb), parameter    :: lu_scale  = 0.2_jprb
63    real(kind=jprb), parameter    :: lu_offset = 1.0_jprb
64    !real(jprb)  :: hook_handle
65
66    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',0,hook_handle)
67
68    ! Convert to effective diameter using the relationship in the IFS
69    !de_um     = re * (1.0e6_jprb / 0.64952_jprb)
70    de_um     = re * 2.0e6_jprb
71
72    ! limit de_um to validity of LUT
73    de_um = max(de_um,10.0_jprb)
74    de_um = min(de_um,119.99_jprb) !avoid greater than or equal to 120 um
75
76    iwp_gm_2  = ice_wp * 1000.0_jprb
77
78    lu_idx = floor(de_um * lu_scale - lu_offset)
79    wts_2  = (de_um * lu_scale - lu_offset) - lu_idx
80    wts_1  = 1.0_jprb - wts_2
81    od     = 0.001_jprb * iwp_gm_2 * &
82             & ( wts_1 * coeff(1:nb,lu_idx) + wts_2 * coeff(1:nb,lu_idx+1) )
83    scat_od = od * &
84             & ( wts_1 * coeff(1:nb,lu_idx+NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+NSingleCoeffs+1) )
85    g = wts_1 * coeff(1:nb,lu_idx+2*NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+2*NSingleCoeffs+1)
86
87    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',1,hook_handle)
88
89  end subroutine calc_ice_optics_yi_sw
90
91
92  !---------------------------------------------------------------------
93  ! Compute longwave ice-particle scattering properties using Yi et
94  ! al. (2013) parameterization
95  subroutine calc_ice_optics_yi_lw(nb, coeff, ice_wp, &
96       &  re, od, scat_od, g)
97
98    use parkind1, only : jprb, jpim
99    !use yomhook,  only : lhook, dr_hook
100
101    ! Number of bands
102    integer, intent(in)  :: nb
103    ! Coefficients read from a data file
104    real(jprb), intent(in) :: coeff(:,:)
105    ! Ice water path (kg m-2)
106    real(jprb), intent(in) :: ice_wp
107    ! Effective radius (m)
108    real(jprb), intent(in) :: re
109    ! Total optical depth, scattering optical depth and asymmetry factor
110    real(jprb), intent(out) :: od(nb), scat_od(nb), g(nb)
111
112    ! Yi's effective diameter (microns)
113    real(jprb) :: de_um
114    ! Ice water path in g m-2
115    real (jprb) :: iwp_gm_2
116    ! LUT temp variables
117    real(jprb) :: wts_1, wts_2
118    integer(jpim) :: lu_idx
119    real(kind=jprb), parameter    :: lu_scale  = 0.2_jprb
120    real(kind=jprb), parameter    :: lu_offset = 1.0_jprb
121    !real(jprb)  :: hook_handle
122
123    !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_sw',0,hook_handle)
124
125    ! Convert to effective diameter using the relationship in the IFS
126    !de_um     = re * (1.0e6_jprb / 0.64952_jprb)
127    de_um     = re * 2.0e6_jprb
128
129    ! limit de_um to validity of LUT
130    de_um = max(de_um,10.0_jprb)
131    de_um = min(de_um,119.99_jprb) !avoid greater than or equal to 120 um
132
133    iwp_gm_2  = ice_wp * 1000.0_jprb
134
135    lu_idx = floor(de_um * lu_scale - lu_offset)
136    wts_2  = (de_um * lu_scale - lu_offset) - lu_idx
137    wts_1  = 1.0_jprb - wts_2
138    od     = 0.001_jprb * iwp_gm_2 * &
139             & ( wts_1 * coeff(1:nb,lu_idx) + wts_2 * coeff(1:nb,lu_idx+1) )
140    scat_od = od * &
141             & ( wts_1 * coeff(1:nb,lu_idx+NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+NSingleCoeffs+1) )
142    g = wts_1 * coeff(1:nb,lu_idx+2*NSingleCoeffs) + wts_2 * coeff(1:nb,lu_idx+2*NSingleCoeffs+1)
143
144     !if (lhook) call dr_hook('radiation_ice_optics:calc_ice_optics_yi_lw',1,hook_handle)
145
146  end subroutine calc_ice_optics_yi_lw
147
148end module radiation_ice_optics_yi
Note: See TracBrowser for help on using the repository browser.