Newer
Older
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$ $Date$
!-----------------------------------------------------------------
! ######spl
MODULE MODI_BEAMBROAD
INTERFACE
SUBROUTINE BEAMBROAD(PDISCR,PSINGPT,PX_H,PX_V,PW_H,PW_V,OMASK)
REAL,DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PDISCR
REAL,DIMENSION(:,:,:,:), INTENT(OUT) :: PSINGPT
REAL, DIMENSION(:), INTENT(IN) :: PX_H ! Gaussian horizontal nodes
REAL, DIMENSION(:), INTENT(IN) :: PX_V ! Gaussian vertical nodes
REAL, DIMENSION(:), INTENT(IN) :: PW_H ! Gaussian horizontal weights
REAL, DIMENSION(:), INTENT(IN) :: PW_V ! Gaussian vertical weights
LOGICAL, INTENT(IN) :: OMASK ! compute bins located after partial mask
END SUBROUTINE BEAMBROAD
END INTERFACE
END MODULE MODI_BEAMBROAD
!
! ##############################################################
SUBROUTINE BEAMBROAD(PDISCR,PSINGPT,PX_H,PX_V,PW_H,PW_V,OMASK)
! ##############################################################
!
!!**** *BEAMBROAD * - takes into account beam broadening with range
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to compute variables on the beam ray from
!! discretized pinpoint rays.
!!
!!** METHOD
!! ------
!! Book2 of documentation ( routine RADAR_SIMULATOR )
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CST
!! Module MODD_PARAMETERS
!! Module MODD_RADAR
!!
!! REFERENCE
!! ---------
!! Book2 of documentation ( routine RADAR_SIMULATOR )
!!
!! AUTHOR
!! ------
!! O. Caumont * Mto-France *
!!
!! MODIFICATIONS
!! -------------
!! Original 10/04/2008
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST , ONLY: XPI
USE MODD_PARAMETERS, ONLY: XUNDEF
USE MODD_RADAR , ONLY: LQUAD,NBELEV
IMPLICIT NONE
REAL,DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PDISCR
REAL,DIMENSION(:,:,:,:), INTENT(OUT) :: PSINGPT
REAL, DIMENSION(:), INTENT(IN) :: PX_H ! Gaussian horizontal nodes
REAL, DIMENSION(:), INTENT(IN) :: PX_V ! Gaussian vertical nodes
REAL, DIMENSION(:), INTENT(IN) :: PW_H ! Gaussian horizontal weights
REAL, DIMENSION(:), INTENT(IN) :: PW_V ! Gaussian vertical weights
LOGICAL, INTENT(IN) :: OMASK ! compute bins located after partial mask
INTEGER :: JI,JL,JEL,JAZ,JH,JV ! Loop control variables
INTEGER :: IEL
INTEGER :: INBRAD,INPTS_H,INPTS_V ! sizes of the arrays
REAL :: ZVTEMP
!
!* 1. INITIALIZATION
! --------------
INBRAD=SIZE(PDISCR,1)
INPTS_H=SIZE(PDISCR,5)
INPTS_V=SIZE(PDISCR,6)
PSINGPT(:,:,:,:)=0.
!
!* 2. CALCULATIONS
! --------------
DO JI=1,INBRAD
IEL=NBELEV(JI)
DO JEL=1,IEL
DO JAZ=1,SIZE(PDISCR,3)
DO JL=1,SIZE(PDISCR,4)
DO JH=1,INPTS_H
ZVTEMP=0.
DO JV=1,INPTS_V ! Loop on Jv
! if previously underground on this beam
IF(JL > 1) THEN
IF(PDISCR(JI,JEL,JAZ,JL-1,JH,JV)==-XUNDEF.AND..NOT.OMASK) &
PDISCR(JI,JEL,JAZ,JL,JH,JV)=-XUNDEF
END IF
IF(PDISCR(JI,JEL,JAZ,JL,JH,JV) /= -XUNDEF.AND.ZVTEMP /= -XUNDEF) THEN
! Quadrature on vertical reflectivities
IF(LQUAD) THEN
ZVTEMP=ZVTEMP+PDISCR(JI,JEL,JAZ,JL,JH,JV)*PW_V(ABS((2*JV-INPTS_V-1)/2)+1) &
*EXP(-2.*LOG(2.)*PX_V(ABS((2*JV-INPTS_V-1)/2)+1)**2)
ELSE
ZVTEMP=ZVTEMP+PDISCR(JI,JEL,JAZ,JL,JH,JV)*PW_V(ABS((2*JV-INPTS_V-1)/2)+1)
END IF
ELSE
ZVTEMP=-XUNDEF
END IF
END DO ! End loop on JV
IF(ZVTEMP /= -XUNDEF .AND. PSINGPT(JI,JEL,JAZ,JL) /= -XUNDEF) THEN
IF(LQUAD) THEN
PSINGPT(JI,JEL,JAZ,JL)=PSINGPT(JI,JEL,JAZ,JL)+ZVTEMP*PW_H(ABS((2*JH-INPTS_H-1)/2)+1) &
*EXP(-2.*LOG(2.)*PX_H(ABS((2*JH-INPTS_H-1)/2)+1)**2)
ELSE
PSINGPT(JI,JEL,JAZ,JL)=PSINGPT(JI,JEL,JAZ,JL)+ZVTEMP*PW_H(ABS((2*JH-INPTS_H-1)/2)+1)
END IF
ELSE
PSINGPT(JI,JEL,JAZ,JL)=-XUNDEF
END IF
END DO ! End loop on JH
IF(PSINGPT(JI,JEL,JAZ,JL) /= -XUNDEF) THEN
IF(LQUAD) THEN
PSINGPT(JI,JEL,JAZ,JL)=PSINGPT(JI,JEL,JAZ,JL)*2.*LOG(2.)/XPI
ELSE
PSINGPT(JI,JEL,JAZ,JL)=PSINGPT(JI,JEL,JAZ,JL)/XPI! ELSE REMAINS -XUNDEF
END IF
END IF
END DO
END DO
END DO
END DO
END SUBROUTINE BEAMBROAD