CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
gwdc_pre.f
1
4
5 module gwdc_pre
6 contains
7
8!! \section arg_table_gwdc_pre_run Argument Table
9!! \htmlinclude gwdc_pre_run.html
10!!
11 subroutine gwdc_pre_run ( &
12 & im, cgwf, dx, work1, work2, dlength, cldf, &
13 & levs, kbot, ktop, dtp, gt0, gt0_init, del, cumabs, &
14 & errmsg, errflg )
15
16 use machine, only : kind_phys
17 implicit none
18
19 integer, intent(in) :: im, levs
20 integer, intent(in) :: kbot(:), ktop(:)
21 real(kind=kind_phys), intent(in) :: dtp
22 real(kind=kind_phys), intent(in) :: cgwf(:)
23 real(kind=kind_phys), intent(in) :: dx(:), work1(:), work2(:)
24 real(kind=kind_phys), intent(in) :: &
25 & gt0(:,:), gt0_init(:,:), del(:,:)
26
27 real(kind=kind_phys), intent(out) :: &
28 & dlength(:), cldf(:), cumabs(:)
29
30 character(len=*), intent(out) :: errmsg
31 integer, intent(out) :: errflg
32
33 integer :: i, k
34 real(kind=kind_phys) :: tem1, tem2
35 real(kind=kind_phys) :: work3(im)
36
37 ! Initialize CCPP error handling variables
38 errmsg = ''
39 errflg = 0
40
41 do i = 1, im
42 tem1 = dx(i)
43 tem2 = tem1
44 dlength(i) = sqrt( tem1*tem1+tem2*tem2 )
45 cldf(i) = cgwf(1)*work1(i) + cgwf(2)*work2(i)
46 enddo
47
48! --- ... calculate maximum convective heating rate
49! cuhr = temperature change due to deep convection
50
51 cumabs(:) = 0.0
52 work3(:) = 0.0
53 do k = 1, levs
54 do i = 1, im
55 if (k >= kbot(i) .and. k <= ktop(i)) then
56 cumabs(i) &
57 & = cumabs(i) + (gt0(i,k) - gt0_init(i,k)) * del(i,k)
58 work3(i) = work3(i) + del(i,k)
59 endif
60 enddo
61 enddo
62 do i=1,im
63 if (work3(i) > 0.0) cumabs(i) = cumabs(i) / (dtp*work3(i))
64 enddo
65
66 end subroutine gwdc_pre_run
67
68 end module gwdc_pre