Line data Source code
1 : module flux_avg
2 :
3 : !---------------------------------------------------------------------------------
4 : ! Purpose: Contains code to smooth the surface fluxes to reduce
5 : ! instabilities in the surface layer.
6 : !---------------------------------------------------------------------------------
7 :
8 : use shr_kind_mod, only: r8=>shr_kind_r8
9 : use ppgrid, only: begchunk, endchunk, pcols
10 :
11 : use physics_types, only: physics_state
12 : use camsrfexch, only: cam_in_t
13 : use phys_grid, only: get_ncols_p
14 : use physics_buffer, only : pbuf_add_field, dtype_r8
15 : implicit none
16 : private
17 : save
18 :
19 : ! Public interfaces
20 :
21 : public :: flux_avg_register
22 : public :: flux_avg_init
23 : public :: flux_avg_run
24 :
25 : ! Private module data
26 :
27 : integer :: lhflx_idx ! lhflx index in physics buffer
28 : integer :: shflx_idx ! shflx index in physics buffer
29 : integer :: qflx_idx ! qflx index in physics buffer
30 : integer :: taux_idx ! taux index in physics buffer
31 : integer :: tauy_idx ! tauy index in physics buffer
32 : integer :: lhflx_res_idx ! lhflx_res index in physics buffer
33 : integer :: shflx_res_idx ! shflx_res index in physics buffer
34 : integer :: qflx_res_idx ! qflx_res index in physics buffer
35 : integer :: taux_res_idx ! taux_res index in physics buffer
36 : integer :: tauy_res_idx ! tauy_res index in physics buffer
37 :
38 : !===============================================================================
39 : contains
40 : !===============================================================================
41 :
42 0 : subroutine flux_avg_register()
43 :
44 : !----------------------------------------------------------------------
45 : !
46 : ! Register the fluxes in the physics buffer.
47 : !
48 : !-----------------------------------------------------------------------
49 :
50 : ! Request physics buffer space for fields that persist across timesteps.
51 0 : call pbuf_add_field('LHFLX', 'global',dtype_r8,(/pcols,1/),lhflx_idx)
52 0 : call pbuf_add_field('SHFLX', 'global',dtype_r8,(/pcols,1/),shflx_idx)
53 0 : call pbuf_add_field('TAUX', 'global',dtype_r8,(/pcols,1/),taux_idx)
54 0 : call pbuf_add_field('TAUY', 'global',dtype_r8,(/pcols,1/),tauy_idx)
55 0 : call pbuf_add_field('QFLX', 'global',dtype_r8,(/pcols,1/),qflx_idx)
56 0 : call pbuf_add_field('LHFLX_RES','global',dtype_r8,(/pcols,1/),lhflx_res_idx)
57 0 : call pbuf_add_field('SHFLX_RES','global',dtype_r8,(/pcols,1/),shflx_res_idx)
58 0 : call pbuf_add_field('TAUX_RES', 'global',dtype_r8,(/pcols,1/),taux_res_idx)
59 0 : call pbuf_add_field('TAUY_RES', 'global',dtype_r8,(/pcols,1/),tauy_res_idx)
60 0 : call pbuf_add_field('QFLX_RES', 'global',dtype_r8,(/pcols,1/),qflx_res_idx)
61 :
62 0 : end subroutine flux_avg_register
63 :
64 : !===============================================================================
65 :
66 0 : subroutine flux_avg_init(cam_in, pbuf2d)
67 : use physics_buffer, only : physics_buffer_desc, pbuf_set_field, pbuf_get_chunk
68 : ! Initialize the surface fluxes in the physics buffer using the cam import state
69 :
70 : type(cam_in_t), intent(in) :: cam_in(begchunk:endchunk)
71 :
72 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
73 : integer :: lchnk
74 : integer :: ncol
75 0 : type(physics_buffer_desc), pointer :: pbuf2d_chunk(:)
76 :
77 : !-----------------------------------------------------------------------
78 :
79 0 : do lchnk = begchunk, endchunk
80 0 : ncol = get_ncols_p(lchnk)
81 0 : pbuf2d_chunk => pbuf_get_chunk(pbuf2d, lchnk)
82 0 : call pbuf_set_field(pbuf2d_chunk, lhflx_idx, cam_in(lchnk)%lhf(:ncol))
83 0 : call pbuf_set_field(pbuf2d_chunk, shflx_idx, cam_in(lchnk)%shf(:ncol))
84 0 : call pbuf_set_field(pbuf2d_chunk, qflx_idx, cam_in(lchnk)%cflx(:ncol,1))
85 0 : call pbuf_set_field(pbuf2d_chunk, taux_idx, cam_in(lchnk)%wsx(:ncol))
86 0 : call pbuf_set_field(pbuf2d_chunk, tauy_idx, cam_in(lchnk)%wsy(:ncol))
87 :
88 0 : call pbuf_set_field(pbuf2d, shflx_res_idx, 0.0_r8)
89 0 : call pbuf_set_field(pbuf2d_chunk, lhflx_res_idx, 0.0_r8)
90 0 : call pbuf_set_field(pbuf2d_chunk, qflx_res_idx, 0.0_r8)
91 0 : call pbuf_set_field(pbuf2d_chunk, taux_res_idx, 0.0_r8)
92 0 : call pbuf_set_field(pbuf2d_chunk, tauy_res_idx, 0.0_r8)
93 : end do
94 :
95 :
96 0 : end subroutine flux_avg_init
97 :
98 : !===============================================================================
99 :
100 0 : subroutine flux_avg_run(state, cam_in, pbuf, nstep, deltat)
101 0 : use physics_buffer, only : physics_buffer_desc, pbuf_get_field
102 : !-----------------------------------------------------------------------
103 : !
104 : ! Purpose:
105 : !
106 : !-----------------------------------------------------------------------
107 :
108 : ! Input arguments
109 :
110 : type(physics_state), intent(in) :: state
111 : type(cam_in_t), intent(inout) :: cam_in
112 : type(physics_buffer_desc), pointer :: pbuf(:)
113 :
114 : integer, intent(in) :: nstep
115 : real(r8), intent(in) :: deltat
116 :
117 : ! Local variables
118 : integer :: lchnk ! chunk identifier
119 : integer :: ncol ! number of atmospheric columns
120 :
121 : ! physics buffer fields
122 0 : real(r8), pointer, dimension(:) :: lhflx ! latent heat flux
123 0 : real(r8), pointer, dimension(:) :: shflx ! sensible heat flux
124 0 : real(r8), pointer, dimension(:) :: qflx ! water vapor heat flux
125 0 : real(r8), pointer, dimension(:) :: taux ! x momentum flux
126 0 : real(r8), pointer, dimension(:) :: tauy ! y momentum flux
127 0 : real(r8), pointer, dimension(:) :: lhflx_res ! latent heat flux
128 0 : real(r8), pointer, dimension(:) :: shflx_res ! sensible heat flux
129 0 : real(r8), pointer, dimension(:) :: qflx_res ! water vapor heat flux
130 0 : real(r8), pointer, dimension(:) :: taux_res ! x momentum flux
131 0 : real(r8), pointer, dimension(:) :: tauy_res ! y momentum flux
132 : !-----------------------------------------------------------------------
133 :
134 0 : lchnk = state%lchnk
135 0 : ncol = state%ncol
136 :
137 : ! Associate pointers with physics buffer fields
138 0 : call pbuf_get_field(pbuf, lhflx_idx, lhflx )
139 0 : call pbuf_get_field(pbuf, shflx_idx, shflx )
140 0 : call pbuf_get_field(pbuf, qflx_idx, qflx )
141 0 : call pbuf_get_field(pbuf, taux_idx, taux )
142 0 : call pbuf_get_field(pbuf, tauy_idx, tauy )
143 :
144 0 : call pbuf_get_field(pbuf, lhflx_res_idx, lhflx_res )
145 0 : call pbuf_get_field(pbuf, shflx_res_idx, shflx_res )
146 0 : call pbuf_get_field(pbuf, qflx_res_idx, qflx_res )
147 0 : call pbuf_get_field(pbuf, taux_res_idx, taux_res )
148 0 : call pbuf_get_field(pbuf, tauy_res_idx, tauy_res )
149 :
150 0 : call smooth (cam_in%lhf, lhflx, lhflx_res, nstep, deltat, ncol)
151 0 : call smooth (cam_in%shf, shflx, shflx_res, nstep, deltat, ncol)
152 0 : call smooth (cam_in%wsx, taux, taux_res, nstep, deltat, ncol)
153 0 : call smooth (cam_in%wsy, tauy, tauy_res, nstep, deltat, ncol)
154 0 : call smooth (cam_in%cflx(:pcols,1), qflx, qflx_res, nstep, deltat, ncol)
155 :
156 0 : end subroutine flux_avg_run
157 :
158 : !===============================================================================
159 :
160 0 : subroutine smooth(new, old, res, nstep, deltat, ncol)
161 :
162 : real(r8), intent(inout) :: new(pcols)
163 : real(r8), intent(inout) :: old(pcols)
164 : real(r8), intent(inout) :: res(pcols)
165 : real(r8), intent(in) :: deltat
166 : integer, intent(in) :: nstep
167 : integer, intent(in) :: ncol
168 :
169 : real(r8) :: temp(pcols)
170 : integer i
171 :
172 0 : temp(1:ncol) = new(1:ncol)
173 0 : if (nstep > 0) then
174 0 : new(1:ncol) = 0.5_r8*(new(1:ncol)+old(1:ncol))
175 : else
176 0 : old(1:ncol) = new(1:ncol)
177 0 : res(1:ncol) = 0._r8
178 : endif
179 :
180 : ! storing the old value for smoothing on the next step
181 : ! doesnt seem to be stable
182 : ! old(1:ncol) = temp(1:ncol)
183 :
184 : ! storing the smoothed value for the next step
185 :
186 : ! first add the flux that the surface model wanted to provide less
187 : ! the flux the atmosphere will actually see to the residual
188 0 : res(1:ncol) = res(1:ncol) + temp(1:ncol)-new(1:ncol)
189 :
190 : ! now calculate the amount that we might increment the new flux
191 : ! to include some of the residual
192 : ! If the residual is small we will just add it all,
193 : ! but if it is large we will add it at the rate required to put
194 : ! the residual back into the flux over a 2 hour period
195 0 : do i = 1,ncol
196 0 : if (abs(res(i)).lt.max(abs(new(i)),abs(old(i)))*0.05_r8) then
197 0 : temp(i) = res(i)
198 0 : res(i) = 0._r8
199 : else
200 0 : temp(i) = res(i)*deltat/7200._r8
201 : ! temp(i) = res(i)*deltat*0.5/7200.
202 0 : res(i) = res(i)-temp(i)
203 : endif
204 : end do
205 :
206 : ! dont do conservative smoothing for first 12 hours
207 0 : if (nstep*deltat/86400._r8 < 0.5_r8) then
208 : ! use this line if your dont want to use the residual
209 : !if (.true.) then
210 0 : temp = 0._r8
211 0 : res = 0._r8
212 : endif
213 :
214 : ! make the new flux the average of the sfc model and last timestep
215 : ! plus some of the residual
216 0 : new(1:ncol) = new(1:ncol) + temp(1:ncol)
217 0 : old(1:ncol) = new(1:ncol)
218 :
219 0 : end subroutine smooth
220 :
221 : !===============================================================================
222 :
223 : end module flux_avg
224 :
|
