source: palm/tags/release-3.1b/SOURCE/calc_precipitation.f90 @ 84

Last change on this file since 84 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 2.5 KB
Line 
1 MODULE calc_precipitation_mod
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: calc_precipitation.f90 4 2007-02-13 11:33:16Z raasch $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.5  2004/01/30 10:15:57  raasch
14! Scalar lower k index nzb replaced by 2d-array nzb_2d
15!
16! Revision 1.1  2000/04/13 14:45:22  schroeter
17! Initial revision
18!
19!
20!
21! Description:
22! ------------
23! Calculate the change of total water content due to precipitation
24! (simplified Kessler scheme)
25!------------------------------------------------------------------------------!
26
27    PRIVATE
28    PUBLIC calc_precipitation
29
30    INTERFACE calc_precipitation
31       MODULE PROCEDURE calc_precipitation
32       MODULE PROCEDURE calc_precipitation_ij
33    END INTERFACE calc_precipitation
34 
35 CONTAINS
36
37
38!------------------------------------------------------------------------------!
39! Call for all grid points
40!------------------------------------------------------------------------------!
41    SUBROUTINE calc_precipitation
42
43       USE arrays_3d
44       USE cloud_parameters
45       USE constants
46       USE indices
47
48       IMPLICIT NONE
49
50       INTEGER ::  i, j, k
51       REAL    :: precipitation_rate
52
53 
54       DO  i = nxl, nxr
55          DO  j = nys, nyn
56             DO  k = nzb_2d(j,i)+1, nzt-1   
57
58                IF ( ql(k,j,i) > ql_crit )  THEN
59                   precipitation_rate = prec_time_const * &
60                                        ( ql(k,j,i) - ql_crit )
61                ELSE
62                   precipitation_rate = 0.0
63                ENDIF
64                tend(k,j,i) = tend(k,j,i) - precipitation_rate
65
66             ENDDO
67          ENDDO
68       ENDDO
69
70    END SUBROUTINE calc_precipitation
71
72
73!------------------------------------------------------------------------------!
74! Call for grid point i,j
75!------------------------------------------------------------------------------!
76    SUBROUTINE calc_precipitation_ij( i, j )
77
78       USE arrays_3d
79       USE cloud_parameters
80       USE constants
81       USE indices
82   
83       IMPLICIT NONE
84
85       INTEGER :: i, j, k
86       REAL    :: precipitation_rate
87
88
89       DO  k = nzb_2d(j,i)+1, nzt-1   
90
91          IF ( ql(k,j,i) > ql_crit )  THEN
92             precipitation_rate = prec_time_const * ( ql(k,j,i) - ql_crit )
93          ELSE
94             precipitation_rate = 0.0
95          ENDIF
96          tend(k,j,i) = tend(k,j,i) - precipitation_rate
97
98       ENDDO
99
100    END SUBROUTINE calc_precipitation_ij
101
102 END MODULE calc_precipitation_mod
Note: See TracBrowser for help on using the repository browser.