source: palm/tags/release-3.1c/SOURCE/impact_of_latent_heat.f90 @ 1552

Last change on this file since 1552 was 39, checked in by raasch, 17 years ago

comments prepared for 3.1c

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