source: LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/cosp/mod_llnl_stats.F90 @ 3373

Last change on this file since 3373 was 3242, checked in by idelkadi, 7 years ago

Nettoyage du code :

  • changement de nomes des routines pour avoir les memes nome des modules
  • corrections
  • dos2unix appliquee aux fichiers
  • Rajouter "implicit none" pour les routines ne le comportant pas
  • Suppression des commentaires unitils

Corrections pour tourner en mode debug :

controle par la cles ok_debug_cosp dans mod_cosp_constants.F90
la valeur par defaut etant .false.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.9 KB
Line 
1! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation.
2! All rights reserved.
3! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
4! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/llnl/llnl_stats.F90 $
5!
6! Redistribution and use in source and binary forms, with or without modification, are permitted
7! provided that the following conditions are met:
8!
9!     * Redistributions of source code must retain the above copyright notice, this list
10!       of conditions and the following disclaimer.
11!     * Redistributions in binary form must reproduce the above copyright notice, this list
12!       of conditions and the following disclaimer in the documentation and/or other materials
13!       provided with the distribution.
14!     * Neither the name of the Lawrence Livermore National Security Limited Liability Corporation
15!       nor the names of its contributors may be used to endorse or promote products derived from
16!       this software without specific prior written permission.
17!
18! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
19! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
20! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
21! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
24! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
25! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26!
27! History
28!
29! Jan 2013 - G. Cesana        - Added betaperp_tot and temp_tot arguments
30!
31
32
33MODULE MOD_LLNL_STATS
34  USE MOD_COSP_CONSTANTS
35  IMPLICIT NONE
36
37CONTAINS
38
39!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
40!-------------------- FUNCTION COSP_CFAD ------------------------
41!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
42FUNCTION COSP_CFAD(Npoints,Ncolumns,Nlevels,Nbins,x,xmin,xmax,bmin,bwidth)
43   ! Input arguments
44   integer,intent(in) :: Npoints,Ncolumns,Nlevels,Nbins
45   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: x
46   real,intent(in) :: xmin,xmax
47   real,intent(in) :: bmin,bwidth
48   
49   real,dimension(Npoints,Nbins,Nlevels) :: cosp_cfad
50   ! Local variables
51   integer :: i, j, k
52   integer :: ibin
53   
54   !--- Input arguments
55   ! Npoints: Number of horizontal points
56   ! Ncolumns: Number of subcolumns
57   ! Nlevels: Number of levels
58   ! Nbins: Number of x axis bins
59   ! x: variable to process (Npoints,Ncolumns,Nlevels)
60   ! xmin: minimum value allowed for x
61   ! xmax: minimum value allowed for x
62   ! bmin: mimumum value of first bin
63   ! bwidth: bin width
64   !
65   ! Output: 2D histogram on each horizontal point (Npoints,Nbins,Nlevels)
66   
67   cosp_cfad = 0.0
68   ! bwidth intervals in the range [bmin,bmax=bmin+Nbins*hwidth]
69   ! Valid x values smaller than bmin and larger than bmax are set
70   ! into the smallest bin and largest bin, respectively.
71   do j = 1, Nlevels, 1
72      do k = 1, Ncolumns, 1
73         do i = 1, Npoints, 1
74            if (x(i,k,j) == R_GROUND) then
75               cosp_cfad(i,:,j) = R_UNDEF
76            elseif ((x(i,k,j) >= xmin) .and. (x(i,k,j) <= xmax)) then
77               ibin = ceiling((x(i,k,j) - bmin)/bwidth)
78               if (ibin > Nbins) ibin = Nbins
79               if (ibin < 1)     ibin = 1
80               cosp_cfad(i,ibin,j) = cosp_cfad(i,ibin,j) + 1.0
81            end if
82         enddo  !i
83      enddo  !k
84   enddo  !j
85   where ((cosp_cfad /= R_UNDEF).and.(cosp_cfad /= 0.0)) cosp_cfad = cosp_cfad / Ncolumns
86END FUNCTION COSP_CFAD
87
88!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
89!------------- SUBROUTINE COSP_LIDAR_ONLY_CLOUD -----------------
90!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91SUBROUTINE COSP_LIDAR_ONLY_CLOUD(Npoints,Ncolumns,Nlevels,temp_tot,beta_tot, &
92                   betaperp_tot,beta_mol,Ze_tot,lidar_only_freq_cloud,tcc)
93   ! Input arguments
94   integer,intent(in) :: Npoints,Ncolumns,Nlevels
95   real,dimension(Npoints,Nlevels),intent(in) :: beta_mol   ! Molecular backscatter
96   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: beta_tot   ! Total backscattered signal
97   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: temp_tot   ! Total backscattered signal
98   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: betaperp_tot   ! perpendicular Total backscattered signal
99   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: Ze_tot     ! Radar reflectivity
100   ! Output arguments
101   real,dimension(Npoints,Nlevels),intent(out) :: lidar_only_freq_cloud
102   real,dimension(Npoints),intent(out) :: tcc
103
104   ! local variables
105   real :: sc_ratio
106   real :: s_cld, s_att
107   parameter (S_cld = 5.0)
108   parameter (s_att = 0.01)
109   integer :: flag_sat !first saturated level encountered from top
110   integer :: flag_cld !cloudy column
111   integer :: pr,i,j
112
113   lidar_only_freq_cloud = 0.0
114   tcc = 0.0
115   do pr=1,Npoints
116     do i=1,Ncolumns
117       flag_sat = 0
118       flag_cld = 0
119       do j=Nlevels,1,-1 !top->surf
120        sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
121        if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
122        if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
123         if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud
124            lidar_only_freq_cloud(pr,j)=lidar_only_freq_cloud(pr,j)+1. !top->surf
125            flag_cld=1
126         endif
127        else  !radar sense cloud (z%Ze_tot(pr,i,j) .ge. -30.)
128           flag_cld=1
129        endif
130       enddo !levels
131       if (flag_cld .eq. 1) tcc(pr)=tcc(pr)+1.
132     enddo !columns
133   enddo !points
134   lidar_only_freq_cloud=lidar_only_freq_cloud/Ncolumns
135   tcc=tcc/Ncolumns
136
137END SUBROUTINE COSP_LIDAR_ONLY_CLOUD
138END MODULE MOD_LLNL_STATS
Note: See TracBrowser for help on using the repository browser.