Line data Source code
1 : !----------------------------------------------------------------------
2 : ! this module computes the total advection tendencies of advected
3 : ! constituents for the finite volume dycore
4 : !----------------------------------------------------------------------
5 : module advect_tend
6 :
7 : use shr_kind_mod, only : r8 => shr_kind_r8
8 :
9 : save
10 : private
11 :
12 : public :: compute_adv_tends_xyz
13 : public :: compute_write_iop_fields
14 :
15 : real(r8), allocatable :: adv_tendxyz(:,:,:,:,:)
16 : real(r8), allocatable :: iop_qtendxyz(:,:,:,:,:)
17 : real(r8), allocatable :: iop_qtendxyz_init(:,:,:,:,:)
18 : real(r8), allocatable :: derivedfq(:,:,:,:,:)
19 : real(r8), allocatable :: iop_ttendxyz(:,:,:,:)
20 : real(r8), allocatable :: iop_ttendxyz_init(:,:,:,:)
21 :
22 : contains
23 :
24 : !----------------------------------------------------------------------
25 : ! computes the total advective tendencies
26 : ! called twice each time step:
27 : ! - first call sets the initial mixing ratios
28 : ! - second call computes and outputs the tendencies
29 : !----------------------------------------------------------------------
30 738816 : subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0)
31 : use cam_history, only: outfld
32 : use time_manager, only: get_step_size
33 : use constituents, only: tottnam,pcnst
34 : use dimensions_mod, only: nc,np,nlev,use_cslam
35 : use element_mod, only: element_t
36 : use fvm_control_volume_mod, only: fvm_struct
37 : implicit none
38 :
39 : type (element_t), intent(in) :: elem(:)
40 : type(fvm_struct), intent(in) :: fvm(:)
41 : integer, intent(in) :: nets,nete,qn0,n0
42 : real(r8) :: dt
43 : integer :: i,j,ic,nx,ie
44 : logical :: init
45 738816 : real(r8), allocatable, dimension(:,:) :: ftmp
46 :
47 738816 : if (use_cslam) then
48 : nx=nc
49 : else
50 0 : nx=np
51 : endif
52 2216448 : allocate( ftmp(nx*nx,nlev) )
53 :
54 738816 : init = .false.
55 738816 : if ( .not. allocated( adv_tendxyz ) ) then
56 369408 : init = .true.
57 2585856 : allocate( adv_tendxyz(nx,nx,nlev,pcnst,nets:nete) )
58 2644522608 : adv_tendxyz(:,:,:,:,:) = 0._r8
59 : endif
60 :
61 738816 : if (use_cslam) then
62 5933616 : do ie=nets,nete
63 21518016 : do ic=1,pcnst
64 5288306400 : adv_tendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - adv_tendxyz(:,:,:,ic,ie)
65 : end do
66 : end do
67 : else
68 0 : do ie=nets,nete
69 0 : do ic=1,pcnst
70 0 : adv_tendxyz(:,:,:,ic,ie) = elem(ie)%state%Qdp(:,:,:,ic,qn0)/elem(ie)%state%dp3d(:,:,:,n0) - adv_tendxyz(:,:,:,ic,ie)
71 : enddo
72 : end do
73 : end if
74 :
75 738816 : if ( .not. init ) then
76 369408 : dt = get_step_size()
77 :
78 2966808 : do ie=nets,nete
79 10759008 : do ic = 1,pcnst
80 31168800 : do j=1,nx
81 101298600 : do i=1,nx
82 1916881200 : ftmp(i+(j-1)*nx,:) = adv_tendxyz(i,j,:,ic,ie)
83 : end do
84 : end do
85 10389600 : call outfld(tottnam(ic), ftmp,nx*nx, ie)
86 : end do
87 : end do
88 369408 : deallocate(adv_tendxyz)
89 : endif
90 738816 : deallocate(ftmp)
91 738816 : end subroutine compute_adv_tends_xyz
92 :
93 : !----------------------------------------------------------------------
94 : ! computes camiop specific tendencies
95 : ! and writes these to the camiop file
96 : ! called twice each time step:
97 : ! - first call sets the initial mixing ratios/state
98 : ! - second call computes and outputs the tendencies
99 : !----------------------------------------------------------------------
100 0 : subroutine compute_write_iop_fields(elem,fvm,nets,nete,qn0,n0)
101 738816 : use cam_abortutils, only: endrun
102 : use cam_history, only: outfld, hist_fld_active
103 : use time_manager, only: get_step_size
104 : use constituents, only: pcnst,cnst_name
105 : use dimensions_mod, only: nc,np,nlev,use_cslam,npsq
106 : use element_mod, only: element_t
107 : use fvm_control_volume_mod, only: fvm_struct
108 : implicit none
109 :
110 : type (element_t), intent(inout) :: elem(:)
111 : type(fvm_struct), intent(inout) :: fvm(:)
112 : integer, intent(in) :: nets,nete,qn0,n0
113 : real(r8) :: dt
114 0 : real(r8), allocatable :: q_new(:,:,:)
115 0 : real(r8), allocatable :: q_adv(:,:,:)
116 0 : real(r8), allocatable :: t_adv(:,:)
117 0 : real(r8), allocatable :: out_q(:,:)
118 0 : real(r8), allocatable :: out_t(:,:)
119 0 : real(r8), allocatable :: out_u(:,:)
120 0 : real(r8), allocatable :: out_v(:,:)
121 0 : real(r8), allocatable :: out_ps(:)
122 :
123 : integer :: i,j,ic,nx,ie,nxsq,p
124 : integer :: ierr
125 : logical :: init
126 : character(len=*), parameter :: sub = 'compute_write_iop_fields:'
127 : !----------------------------------------------------------------------------
128 :
129 0 : if (use_cslam) then
130 : nx=nc
131 : else
132 0 : nx=np
133 : endif
134 0 : nxsq=nx*nx
135 :
136 0 : init = .false.
137 0 : dt = get_step_size()
138 :
139 0 : if ( .not. allocated( iop_qtendxyz ) ) then
140 0 : init = .true.
141 :
142 0 : allocate( iop_qtendxyz(nx,nx,nlev,pcnst,nets:nete),stat=ierr )
143 0 : if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' )
144 0 : iop_qtendxyz = 0._r8
145 0 : allocate( derivedfq(nx,nx,nlev,pcnst,nets:nete),stat=ierr )
146 0 : if (ierr/=0) call endrun( sub//': not able to allocate derivedfq' )
147 0 : derivedfq = 0._r8
148 0 : allocate( iop_qtendxyz_init(nx,nx,nlev,pcnst,nets:nete),stat=ierr )
149 0 : if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' )
150 0 : iop_qtendxyz_init = 0._r8
151 0 : allocate( iop_ttendxyz(nx,nx,nlev,nets:nete),stat=ierr )
152 0 : if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz' )
153 0 : iop_ttendxyz = 0._r8
154 0 : allocate( iop_ttendxyz_init(nx,nx,nlev,nets:nete),stat=ierr )
155 0 : if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz_init' )
156 0 : iop_ttendxyz_init = 0._r8
157 : endif
158 :
159 : ! save initial/calc tendencies on second call to this routine.
160 0 : if (use_cslam) then
161 0 : do ie=nets,nete
162 0 : do ic=1,pcnst
163 0 : iop_qtendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - iop_qtendxyz(:,:,:,ic,ie)
164 : end do
165 : end do
166 : else
167 0 : do ie=nets,nete
168 0 : do ic=1,pcnst
169 0 : iop_qtendxyz(:,:,:,ic,ie) = elem(ie)%state%Qdp(:,:,:,ic,qn0)/elem(ie)%state%dp3d(:,:,:,n0) - iop_qtendxyz(:,:,:,ic,ie)
170 : enddo
171 : end do
172 : end if
173 0 : do ie=nets,nete
174 0 : iop_ttendxyz(:,:,:,ie) = elem(ie)%state%T(:,:,:,n0) - iop_ttendxyz(:,:,:,ie)
175 : end do
176 :
177 0 : if (init) then
178 0 : do ie=nets,nete
179 0 : iop_ttendxyz_init(:,:,:,ie) = iop_ttendxyz(:,:,:,ie)
180 0 : iop_qtendxyz_init(:,:,:,:,ie) = iop_qtendxyz(:,:,:,:,ie)
181 0 : derivedfq(:,:,:,:,ie)=elem(ie)%derived%FQ(:,:,:,:)/dt
182 : end do
183 : end if
184 :
185 : if ( .not. init ) then
186 0 : allocate( q_adv(nxsq,nlev,pcnst),stat=ierr )
187 0 : if (ierr/=0) call endrun( sub//': not able to allocate q_adv' )
188 0 : q_adv = 0._r8
189 0 : allocate( t_adv(npsq,nlev),stat=ierr )
190 0 : if (ierr/=0) call endrun( sub//': not able to allocate t_adv' )
191 0 : t_adv = 0._r8
192 0 : allocate( q_new(nx,nx,nlev),stat=ierr )
193 0 : if (ierr/=0) call endrun( sub//': not able to allocate q_new' )
194 0 : q_new = 0._r8
195 0 : allocate( out_q(npsq,nlev),stat=ierr )
196 0 : if (ierr/=0) call endrun( sub//': not able to allocate out_q' )
197 0 : out_q = 0._r8
198 0 : allocate( out_t(npsq,nlev),stat=ierr )
199 0 : if (ierr/=0) call endrun( sub//': not able to allocate out_t' )
200 0 : out_t = 0._r8
201 0 : allocate( out_u(npsq,nlev),stat=ierr )
202 0 : if (ierr/=0) call endrun( sub//': not able to allocate out_u' )
203 0 : out_u = 0._r8
204 0 : allocate( out_v(npsq,nlev),stat=ierr )
205 0 : if (ierr/=0) call endrun( sub//': not able to allocate out_v' )
206 0 : out_v = 0._r8
207 0 : allocate( out_ps(npsq),stat=ierr )
208 0 : if (ierr/=0) call endrun( sub//': not able to allocate out_ps' )
209 0 : out_ps = 0._r8
210 0 : do ie=nets,nete
211 0 : do j=1,nx
212 0 : do i=1,nx
213 0 : t_adv(i+(j-1)*np,:) = iop_ttendxyz(i,j,:,ie)/dt - elem(ie)%derived%FT(i,j,:)
214 0 : out_u(i+(j-1)*np,:) = elem(ie)%state%v(i,j,1,:,n0)
215 0 : out_v(i+(j-1)*np,:) = elem(ie)%state%v(i,j,2,:,n0)
216 0 : out_ps(i+(j-1)*np) = elem(ie)%state%psdry(i,j)
217 :
218 : ! to retain bfb, replace state q and t with roundoff version calculated using the ordering and tendencies of the
219 : ! scam prognostic equation
220 0 : elem(ie)%state%T(i,j,:,n0) = iop_ttendxyz_init(i,j,:,ie) + dt*(elem(ie)%derived%FT(i,j,:) + t_adv(i+(j-1)*np,:))
221 0 : out_t(i+(j-1)*np,:) = elem(ie)%state%T(i,j,:,n0)
222 0 : do p=1,pcnst
223 0 : q_adv(i+(j-1)*nx,:,p) = iop_qtendxyz(i,j,:,p,ie)/dt - derivedfq(i,j,:,p,ie)
224 0 : q_new(i,j,:) = iop_qtendxyz_init(i,j,:,p,ie) + dt*(derivedfq(i,j,:,p,ie) + q_adv(i+(j-1)*nx,:,p))
225 0 : if (use_cslam) then
226 0 : fvm(ie)%c(i,j,:,p)=q_new(i,j,:)
227 : else
228 0 : elem(ie)%state%Qdp(i,j,:,p,qn0)=q_new(i,j,:)*elem(ie)%state%dp3d(i,j,:,n0)
229 : end if
230 : enddo
231 0 : out_q(i+(j-1)*nx,:) = elem(ie)%state%Qdp(i,j,:,1,qn0)/elem(ie)%state%dp3d(i,j,:,n0)
232 : end do
233 : end do
234 0 : call outfld('Ps',out_ps,npsq,ie)
235 0 : call outfld('t',out_t,npsq,ie)
236 0 : call outfld('q',out_q,nxsq,ie)
237 0 : call outfld('u',out_u,npsq,ie)
238 0 : call outfld('v',out_v,npsq,ie)
239 0 : call outfld('divT3d',t_adv,npsq,ie)
240 0 : do p=1,pcnst
241 0 : call outfld(trim(cnst_name(p))//'_dten',q_adv(:,:,p),nxsq,ie)
242 : enddo
243 : end do
244 :
245 0 : deallocate(iop_ttendxyz)
246 0 : deallocate(iop_ttendxyz_init)
247 0 : deallocate(iop_qtendxyz)
248 0 : deallocate(iop_qtendxyz_init)
249 0 : deallocate(derivedfq)
250 0 : deallocate(out_t)
251 0 : deallocate(out_q)
252 0 : deallocate(out_u)
253 0 : deallocate(out_v)
254 0 : deallocate(out_ps)
255 0 : deallocate(t_adv)
256 0 : deallocate(q_adv)
257 0 : deallocate(q_new)
258 :
259 : endif
260 0 : end subroutine compute_write_iop_fields
261 :
262 : end module advect_tend
|
