Newer
Older
!MNH_LIC Copyright 2018-2021 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.
!-------------------------------------------------------------------------------
MODULE MODE_LIMA_SNOW_SELF_COLLECTION
IMPLICIT NONE
CONTAINS
! #############################################################
SUBROUTINE LIMA_SNOW_SELF_COLLECTION (LDCOMPUTE, &
PRHODREF, PT, &
PRST, PCST, PLBDS, &
P_CS_SSC )
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
! #############################################################
!
!! PURPOSE
!! -------
!! Compute the self-collection and physical break-up of snow
!!
!!
!! AUTHOR
!! ------
!! J.-M. Cohard * Laboratoire d'Aerologie*
!! J.-P. Pinty * Laboratoire d'Aerologie*
!! S. Berthet * Laboratoire d'Aerologie*
!! B. Vié * CNRM *
!!
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST, ONLY : XTT
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XCEXVT
USE MODD_PARAM_LIMA_COLD, ONLY : NSCLBDAS, XSCINTP1S, XSCINTP2S, XKER_N_SSCS, XFNSSCS, XCOLEXSS, &
XLBNSSCS1, XLBNSSCS2
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
!
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
!
REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow mr at t
REAL, DIMENSION(:), INTENT(IN) :: PCST ! Snow C. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
!
REAL, DIMENSION(:), INTENT(OUT) :: P_CS_SSC
!
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(SIZE(PCST)) :: &
ZW1, & ! work arrays
ZW2
LOGICAL, DIMENSION(SIZE(PCST)) :: GSSC
INTEGER :: IGSSC, JJ
INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices
REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors
!
!-------------------------------------------------------------------------------
!
!
!* 1. Snow self-collection and break-up
! ---------------------------------
!
!
P_CS_SSC(:)=0.
!
ZW1(:) =0.
ZW2(:) =0.
!
GSSC(:) = PCST(:)>XCTMIN(5) .AND. PRST(:)>XRTMIN(5)
IGSSC = COUNT(GSSC(:))
!
IF( IGSSC>0 ) THEN
!
! 1.3N.0 allocations
!
ALLOCATE(ZVEC1(IGSSC))
ALLOCATE(IVEC1(IGSSC))
!
! 1.3N.1 select the (ZLBDAS,ZLBDAS) couplet
!
ZVEC1(:) = PACK( PLBDS(:),MASK=GSSC(:) )
!
! 1.3N.2 find the next lower indice for the ZLBDAS and for the ZLBDAS
! in the geometrical set of (Lbda_s,Lbda_s) couplet use to
! tabulate the SACCS-kernel
!
ZVEC1(1:IGSSC) = MAX( 1.0001, MIN( FLOAT(NSCLBDAS)-0.0001, &
XSCINTP1S * LOG( ZVEC1(1:IGSSC) ) + XSCINTP2S ) )
IVEC1(1:IGSSC) = INT( ZVEC1(1:IGSSC) )
ZVEC1(1:IGSSC) = ZVEC1(1:IGSSC) - FLOAT( IVEC1(1:IGSSC) )
!
! 1.3N.3 perform the bilinear interpolation of the normalized
! SSCS-kernel
!
ALLOCATE(ZVEC3(IGSSC))
DO JJ = 1,IGSSC
ZVEC3(JJ) = ( XKER_N_SSCS(IVEC1(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- XKER_N_SSCS(IVEC1(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* ZVEC1(JJ) &
- ( XKER_N_SSCS(IVEC1(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
- XKER_N_SSCS(IVEC1(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
ZW1(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GSSC(:),FIELD=0.0 ) !! NSACCS
DEALLOCATE(ZVEC3)
!
WHERE( GSSC(:) )
P_CS_SSC(:) = - XFNSSCS * ZW1(:) * EXP( XCOLEXSS*(PT(:)-XTT) ) * PCST(:)**2 &
* PRHODREF(:)**(-XCEXVT-1.) * (XLBNSSCS1+XLBNSSCS2) / PLBDS(:)**2
END WHERE
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC1)
END IF
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_SNOW_SELF_COLLECTION
END MODULE MODE_LIMA_SNOW_SELF_COLLECTION