CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
mp_thompson_post.F90
2
3 use mpi_f08
4 use machine, only : kind_phys
5
6 implicit none
7
8 public :: mp_thompson_post_init, mp_thompson_post_run, mp_thompson_post_finalize
9
10 private
11
12 logical :: is_initialized = .false.
13
14 logical :: apply_limiter
15
16contains
17
18!! \section arg_table_mp_thompson_post_init Argument Table
19!! \htmlinclude mp_thompson_post_init.html
20!!
21 subroutine mp_thompson_post_init(ttendlim, errmsg, errflg)
22
23 implicit none
24
25 ! Interface variables
26 real(kind_phys), intent(in) :: ttendlim
27
28 ! CCPP error handling
29 character(len=*), intent( out) :: errmsg
30 integer, intent( out) :: errflg
31
32 ! Local variables
33 integer :: i
34
35 ! Initialize the CCPP error handling variables
36 errmsg = ''
37 errflg = 0
38
39 ! Check initialization state
40 if (is_initialized) return
41
42 if (ttendlim < 0) then
43 apply_limiter = .false.
44 else
45 apply_limiter = .true.
46 end if
47
48 is_initialized = .true.
49
50 end subroutine mp_thompson_post_init
51
55 subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendlim, &
56 kdt, mpicomm, mpirank, mpiroot, errmsg, errflg)
57
58 implicit none
59
60 ! Interface variables
61 integer, intent(in) :: ncol
62 integer, intent(in) :: nlev
63 real(kind_phys), dimension(:,:), intent(in) :: tgrs_save
64 real(kind_phys), dimension(:,:), intent(inout) :: tgrs
65 real(kind_phys), dimension(:,:), intent(in) :: prslk
66 real(kind_phys), intent(in) :: dtp
67 real(kind_phys), intent(in) :: ttendlim
68 integer, intent(in) :: kdt
69 ! MPI information
70 type(mpi_comm), intent(in ) :: mpicomm
71 integer, intent(in ) :: mpirank
72 integer, intent(in ) :: mpiroot
73 ! CCPP error handling
74 character(len=*), intent( out) :: errmsg
75 integer, intent( out) :: errflg
76
77 ! Local variables
78 real(kind_phys), dimension(1:ncol,1:nlev) :: mp_tend
79 integer :: i, k
80#ifdef DEBUG
81 integer :: events
82#endif
83
84 ! Initialize the CCPP error handling variables
85 errmsg = ''
86 errflg = 0
87
88 ! Check initialization state
89 if (.not.is_initialized) then
90 write(errmsg, fmt='((a))') 'mp_thompson_post_run called before mp_thompson_post_init'
91 errflg = 1
92 return
93 end if
94
95 ! If limiter is deactivated, return immediately
96 if (.not.apply_limiter) return
97
98 ! mp_tend and ttendlim are expressed in potential temperature
99 mp_tend = (tgrs - tgrs_save)/prslk
100
101#ifdef DEBUG
102 events = 0
103#endif
104 do k=1,nlev
105 do i=1,ncol
106 mp_tend(i,k) = max( -ttendlim*dtp, min( ttendlim*dtp, mp_tend(i,k) ) )
107
108#ifdef DEBUG
109 if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then
110 write(0,'(a,3i6,3e16.7)') "mp_thompson_post_run mp_tend limiter: kdt, i, k, t_old, t_new, t_lim:", &
111 & kdt, i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k)
112 events = events + 1
113 end if
114#endif
115 tgrs(i,k) = tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k)
116 end do
117 end do
118
119#ifdef DEBUG
120 if (events > 0) then
121 write(0,'(a,i0,a,i0,a,i0)') "mp_thompson_post_run: ttendlim applied ", events, "/", nlev*ncol, &
122 & " times at timestep ", kdt
123 end if
124#endif
125
126 end subroutine mp_thompson_post_run
127
128!! \section arg_table_mp_thompson_post_finalize Argument Table
129!! \htmlinclude mp_thompson_post_finalize.html
130!!
131 subroutine mp_thompson_post_finalize(errmsg, errflg)
132
133 implicit none
134
135 ! CCPP error handling
136 character(len=*), intent( out) :: errmsg
137 integer, intent( out) :: errflg
138
139 ! initialize ccpp error handling variables
140 errmsg = ''
141 errflg = 0
142
143 ! Check initialization state
144 if (.not. is_initialized) return
145
146 is_initialized = .false.
147
148 end subroutine mp_thompson_post_finalize
149
150end module mp_thompson_post