SURFEX v8.1
General documentation of Surfex
average2_cti.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #######################
6  SUBROUTINE average2_cti
7 ! #######################
8 !
9 !!**** *AVERAGE2_CTI* computes the topo index stats
10 !!
11 !! PURPOSE
12 !! -------
13 !!
14 !! METHOD
15 !! ------
16 !!
17 !! EXTERNAL
18 !! --------
19 !!
20 !! IMPLICIT ARGUMENTS
21 !! ------------------
22 !!
23 !! REFERENCE
24 !! ---------
25 !!
26 !! AUTHOR
27 !! ------
28 !!
29 !! B. Decharme Meteo-France
30 !!
31 !! MODIFICATION
32 !! ------------
33 !!
34 !! Original 06/2009
35 !!
36 !----------------------------------------------------------------------------
37 !
38 !* 0. DECLARATION
39 ! -----------
40 !
41 USE modd_surf_par, ONLY : xundef
42 USE modd_pgdwork, ONLY : nsize, xsumval, xprec, &
45 !
46 !
47 USE yomhook ,ONLY : lhook, dr_hook
48 USE parkind1 ,ONLY : jprb
49 !
50 IMPLICIT NONE
51 !
52 !* 0.1 Declaration of arguments
53 ! ------------------------
54 !
55 !* 0.2 Declaration of other local variables
56 ! ------------------------------------
57 !
58 REAL, DIMENSION(SIZE(NSIZE,1)) :: ZSIZE
59 !
60 REAL :: ZINT
61 INTEGER :: JI
62 REAL(KIND=JPRB) :: ZHOOK_HANDLE
63 !----------------------------------------------------------------------------
64 !
65 IF (lhook) CALL dr_hook('AVERAGE2_CTI',0,zhook_handle)
66 zsize(:)=REAL(nsize(:,1))
67 !
68 WHERE (nsize(:,1)>=36)
69 !
70 !----------------------------------------------------------------------------
71 !
72 !* 1. Mean CTI
73 ! --------------
74 !
75  xmean_work(:) = xsumval(:,1)/zsize(:)
76 !
77 !-------------------------------------------------------------------------------
78 !
79 !* 2. Standard deviation
80 ! ------------------
81 !
82  WHERE (xmax_work(:)-xmin_work(:)>=1.0)
83  xstd_work(:) = sqrt( max(0.,xsumval(:,2)/nsize(:,1) - xmean_work(:)*xmean_work(:)) )
84  ELSEWHERE
85  xstd_work(:) = 0.0
86  END WHERE
87 !
88 !-------------------------------------------------------------------------------
89 !
90 !* 3. Skewness
91 ! --------
92 !
93  WHERE(xstd_work(:)>0.0)
94 !
95  xskew_work(:) = xsumval(:,3)-zsize(:)*xmean_work(:)*xmean_work(:)*xmean_work(:) &
96  -3.0*zsize(:)*xmean_work(:)*xstd_work(:)*xstd_work(:)
97 !
98  xskew_work(:) = xskew_work(:)/(zsize(:)*xstd_work(:)*xstd_work(:)*xstd_work(:))
99 !
100  END WHERE
101 !
102 END WHERE
103 !----------------------------------------------------------------------------
104 !
105 DO ji = 1,SIZE(xmean_work,1)
106 
107  IF (xmean_work(ji)/=xundef) THEN
108 
109  zint = aint(xmean_work(ji))
110  IF (xmean_work(ji)/=zint) &
111  xmean_work(ji) = zint + anint((xmean_work(ji)-zint)*xprec)/xprec
112 
113  zint = aint(xmin_work(ji))
114  IF (xmin_work(ji)/=zint) &
115  xmin_work(ji) = zint + anint((xmin_work(ji)-zint)*xprec)/xprec
116 
117  zint = aint(xmax_work(ji))
118  IF (xmax_work(ji)/=zint) &
119  xmax_work(ji) = zint + anint((xmax_work(ji)-zint)*xprec)/xprec
120 
121  zint = aint(xstd_work(ji))
122  IF (xstd_work(ji)/=zint) &
123  xstd_work(ji) = zint + anint((xstd_work(ji)-zint)*xprec)/xprec
124 
125  zint = aint(xskew_work(ji))
126  IF (xskew_work(ji)/=zint) &
127  xskew_work(ji) = zint + anint((xskew_work(ji)-zint)*xprec)/xprec
128 !
129  ENDIF
130 ENDDO
131 !
132 IF (lhook) CALL dr_hook('AVERAGE2_CTI',1,zhook_handle)
133 !
134 !-------------------------------------------------------------------------------
135 !
136 END SUBROUTINE average2_cti
real, parameter xprec
real, dimension(:), allocatable xmax_work
real, parameter xundef
integer, parameter jprb
Definition: parkind1.F90:32
subroutine average2_cti
Definition: average2_cti.F90:7
real, dimension(:,:), allocatable xsumval
real, dimension(:), allocatable xmean_work
real, dimension(:), allocatable xskew_work
logical lhook
Definition: yomhook.F90:15
integer, dimension(:,:), allocatable nsize
real, dimension(:), allocatable xmin_work
real, dimension(:), allocatable xstd_work