source: palm/tags/release-5.0/SOURCE/diagnostic_quantities_mod.f90 @ 4383

Last change on this file since 4383 was 2696, checked in by kanani, 6 years ago

Merge of branch palm4u into trunk

  • Property svn:keywords set to Id
File size: 4.1 KB
Line 
1!> @file diagnostic_quantities_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------!
26! $Id: diagnostic_quantities_mod.f90 2696 2017-12-14 17:12:51Z Giersch $
27! Initial revision
28!
29!
30! Description:
31! ------------
32!> This module contains subroutines and functions for the calculation of
33!> diagnostic quantities. Especially moisture quantities such as the saturation
34!> mixining ratio is calculated
35!------------------------------------------------------------------------------!
36MODULE diagnostic_quantities_mod
37 
38
39   USE kinds
40   
41   IMPLICIT NONE
42
43   REAL(wp) ::  alpha   !< correction factor
44   REAL(wp) ::  e_s     !< saturation water vapor pressure
45   REAL(wp) ::  q_s     !< saturation mixing ratio
46   REAL(wp) ::  sat     !< supersaturation
47   REAL(wp) ::  t_l     !< actual temperature
48
49   PRIVATE
50   PUBLIC  e_s, magnus, q_s, sat, supersaturation, t_l
51
52    INTERFACE supersaturation
53       MODULE PROCEDURE supersaturation
54    END INTERFACE supersaturation
55
56 CONTAINS
57 
58!------------------------------------------------------------------------------!
59! Description:
60! ------------
61!> Computation of the diagnostic supersaturation sat, actual temperature t_l
62!< and saturation water vapor mixing ratio q_
63!------------------------------------------------------------------------------!
64    SUBROUTINE supersaturation ( i,j,k )
65
66       USE arrays_3d,                                                          &
67           ONLY:  hyp, pt, q, qc, qr
68
69       USE cloud_parameters,                                                   &
70           ONLY:  l_d_cp, l_d_r, t_d_pt                                             
71
72       IMPLICIT NONE
73
74       INTEGER(iwp) ::  i                 !<
75       INTEGER(iwp) ::  j                 !<
76       INTEGER(iwp) ::  k                 !<
77!
78!--    Actual liquid water temperature:
79       t_l = t_d_pt(k) * pt(k,j,i)
80!
81!--    Calculate water vapor saturation pressure
82       e_s = magnus( t_l )
83!
84!--    Computation of saturation humidity:
85       q_s   = 0.622_wp * e_s / ( hyp(k) - e_s )
86!
87!--    Correction factor
88       alpha = 0.622_wp * l_d_r * l_d_cp / ( t_l * t_l )
89!
90!--    Correction of the approximated value
91!--    (see: Cuijpers + Duynkerke, 1993, JAS, 23)
92       q_s   = q_s * ( 1.0_wp + alpha * q(k,j,i) ) / ( 1.0_wp + alpha * q_s )
93!
94!--    Supersaturation:
95       sat   = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp
96
97    END SUBROUTINE supersaturation
98
99 
100!------------------------------------------------------------------------------!
101! Description:
102! ------------
103!> This function computes the magnus function (Press et al., 1992).
104!> The magnus formula is needed to calculate the saturation vapor pressure
105!------------------------------------------------------------------------------!
106
107    FUNCTION magnus( temperature )
108
109       IMPLICIT NONE
110
111       REAL(wp)     ::  magnus            !<
112       REAL(wp)     ::  temperature       !<
113
114!
115!--    Saturation vapor pressure at t_l:
116       magnus =  611.2_wp * EXP( 17.62_wp * ( temperature - 273.15_wp ) /      & 
117                                            ( temperature - 29.65_wp  ) )
118
119!        magnus = 610.78_wp * EXP( 17.269_wp * ( temperature - 273.16_wp ) /     &
120!                                              ( temperature - 35.86_wp )        &
121!                                )
122
123    END FUNCTION magnus
124
125
126END MODULE diagnostic_quantities_mod
Note: See TracBrowser for help on using the repository browser.