1 | ! (c) British Crown Copyright 2008, the Met Office. |
---|
2 | ! All rights reserved. |
---|
3 | ! |
---|
4 | ! Redistribution and use in source and binary forms, with or without modification, are permitted |
---|
5 | ! provided that the following conditions are met: |
---|
6 | ! |
---|
7 | ! * Redistributions of source code must retain the above copyright notice, this list |
---|
8 | ! of conditions and the following disclaimer. |
---|
9 | ! * Redistributions in binary form must reproduce the above copyright notice, this list |
---|
10 | ! of conditions and the following disclaimer in the documentation and/or other materials |
---|
11 | ! provided with the distribution. |
---|
12 | ! * Neither the name of the Met Office nor the names of its contributors may be used |
---|
13 | ! to endorse or promote products derived from this software without specific prior written |
---|
14 | ! permission. |
---|
15 | ! |
---|
16 | ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR |
---|
17 | ! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND |
---|
18 | ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR |
---|
19 | ! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
---|
20 | ! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
---|
21 | ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER |
---|
22 | ! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT |
---|
23 | ! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
---|
24 | |
---|
25 | ! |
---|
26 | ! History: |
---|
27 | ! Jul 2007 - A. Bodas-Salcedo - Initial version |
---|
28 | ! Oct 2008 - S. Bony - Instructions "Call for large-scale cloud" removed -> sgx%frac_out is used instead. |
---|
29 | ! Call lidar_simulator changed (lsca, gbx%cca and depol removed; |
---|
30 | ! frac_out changed in sgx%frac_out) |
---|
31 | ! |
---|
32 | ! |
---|
33 | MODULE MOD_COSP_LIDAR |
---|
34 | USE MOD_COSP_CONSTANTS |
---|
35 | USE MOD_COSP_TYPES |
---|
36 | IMPLICIT NONE |
---|
37 | |
---|
38 | CONTAINS |
---|
39 | |
---|
40 | |
---|
41 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
42 | !------------------- SUBROUTINE COSP_LIDAR ------------------------ |
---|
43 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
44 | SUBROUTINE COSP_LIDAR(gbx,sgx,sghydro,y) |
---|
45 | |
---|
46 | ! Arguments |
---|
47 | type(cosp_gridbox),intent(in) :: gbx ! Gridbox info |
---|
48 | type(cosp_subgrid),intent(in) :: sgx ! Subgrid info |
---|
49 | type(cosp_sghydro),intent(in) :: sghydro ! Subgrid info for hydrometeors |
---|
50 | type(cosp_sglidar),intent(inout) :: y ! Subgrid output |
---|
51 | |
---|
52 | ! Local variables |
---|
53 | integer :: i |
---|
54 | real :: presf(sgx%Npoints, sgx%Nlevels + 1) |
---|
55 | real :: frac_out(sgx%Npoints, sgx%Nlevels) |
---|
56 | real,dimension(sgx%Npoints, sgx%Nlevels) :: lsca,mr_ll,mr_li,mr_cl,mr_ci |
---|
57 | real,dimension(sgx%Npoints, sgx%Nlevels) :: beta_tot,tau_tot |
---|
58 | real,dimension(sgx%Npoints, PARASOL_NREFL) :: refle |
---|
59 | |
---|
60 | |
---|
61 | presf(:,1:sgx%Nlevels) = gbx%ph |
---|
62 | presf(:,sgx%Nlevels + 1) = 0.0 |
---|
63 | ! presf(:,sgx%Nlevels + 1) = gbx%p(:,sgx%Nlevels) - (presf(:,sgx%Nlevels) - gbx%p(:,sgx%Nlevels)) |
---|
64 | lsca = gbx%tca-gbx%cca |
---|
65 | do i=1,sgx%Ncolumns |
---|
66 | ! Temporary arrays for simulator call |
---|
67 | mr_ll(:,:) = sghydro%mr_hydro(:,i,:,I_LSCLIQ) |
---|
68 | mr_li(:,:) = sghydro%mr_hydro(:,i,:,I_LSCICE) |
---|
69 | mr_cl(:,:) = sghydro%mr_hydro(:,i,:,I_CVCLIQ) |
---|
70 | mr_ci(:,:) = sghydro%mr_hydro(:,i,:,I_CVCICE) |
---|
71 | frac_out(:,:) = sgx%frac_out(:,i,:) |
---|
72 | call lidar_simulator(sgx%Npoints, sgx%Nlevels, 4 & |
---|
73 | , PARASOL_NREFL, LIDAR_UNDEF & |
---|
74 | , gbx%p, presf, gbx%T & |
---|
75 | , mr_ll, mr_li, mr_cl, mr_ci & |
---|
76 | , gbx%Reff(:,:,I_LSCLIQ), gbx%Reff(:,:,I_LSCICE), gbx%Reff(:,:,I_CVCLIQ), gbx%Reff(:,:,I_CVCICE) & |
---|
77 | , frac_out, gbx%lidar_ice_type, y%beta_mol, beta_tot, tau_tot & |
---|
78 | , refle ) ! reflectance |
---|
79 | |
---|
80 | y%beta_tot(:,i,:) = beta_tot(:,:) |
---|
81 | y%tau_tot(:,i,:) = tau_tot(:,:) |
---|
82 | y%refl(:,i,:) = refle(:,:) |
---|
83 | enddo |
---|
84 | |
---|
85 | END SUBROUTINE COSP_LIDAR |
---|
86 | |
---|
87 | END MODULE MOD_COSP_LIDAR |
---|