FV3 Bundle
fv3jedi_lm_dynamics_mod.F90
Go to the documentation of this file.
2 
6 
7 use fms_mod, only: set_domain, nullify_domain
8 use mpp_mod, only: mpp_pe, mpp_root_pe
10 
16 use fv_dynamics_tlm_mod, only: fv_dynamics_tlm, fv_dynamics_nlm => fv_dynamics
19 
22 
23 !> Top level for fv3jedi linearized dynamical core
24 
25 implicit none
26 private
28 
30  type(fv_atmos_type), allocatable :: fv_atm(:) !<Traj FV3 structure
31  type(fv_atmos_pert_type), allocatable :: fv_atmp(:) !<Pert FV3 structure
32  real(kind_real), allocatable, dimension(:,:) :: ebuffery !<Halo holder
33  real(kind_real), allocatable, dimension(:,:) :: nbufferx !<Halo holder
34  real(kind_real), allocatable, dimension(:,:) :: wbuffery !<Halo holder
35  real(kind_real), allocatable, dimension(:,:) :: sbufferx !<Halo holder
36  integer :: isc,iec,jsc,jec !<Grid, compute region
37  integer :: isd,ied,jsd,jed !<Grid, with halo
38  integer :: npz !<Number of vertical levels
39  integer :: cp_dyn_ind
40  integer :: linmodtest = 0
41  contains
42  procedure :: create
43  procedure :: init_nl
44  procedure :: init_tl
45  procedure :: init_ad
46  procedure :: step_nl
47  procedure :: step_tl
48  procedure :: step_ad
49  procedure :: delete
50  procedure :: traj_to_fv3
51  procedure :: fv3_to_traj
52  procedure :: pert_to_fv3
53  procedure :: fv3_to_pert
55 
56 contains
57 
58 ! ------------------------------------------------------------------------------
59 
60 subroutine create(self,conf)
61 
62  implicit none
63 
64  class(fv3jedi_lm_dynamics_type), target, intent(inout) :: self
65  type(fv3jedi_lm_conf), intent(inout) :: conf
66 
67  logical, allocatable :: grids_on_this_pe(:)
68  integer :: p_split = 1
69  integer :: i,j,tmp
70  real(kind_real) :: f_coriolis_angle
71 
72  type(fv_atmos_type), pointer :: FV_Atm(:)
73 
74  call fv_init(self%FV_Atm, conf%dt, grids_on_this_pe, p_split)
75 
76  fv_atm => self%FV_Atm
77 
78  if (allocated(grids_on_this_pe)) deallocate(grids_on_this_pe)
79  if (allocated(pelist_all)) deallocate(pelist_all)
80 
81  !Halo holders for domain grid
82  allocate(self%wbuffery(fv_atm(1)%bd%jsc:fv_atm(1)%bd%jec,fv_atm(1)%npz))
83  allocate(self%sbufferx(fv_atm(1)%bd%isc:fv_atm(1)%bd%iec,fv_atm(1)%npz))
84  allocate(self%ebuffery(fv_atm(1)%bd%jsc:fv_atm(1)%bd%jec,fv_atm(1)%npz))
85  allocate(self%nbufferx(fv_atm(1)%bd%isc:fv_atm(1)%bd%iec,fv_atm(1)%npz))
86 
87  !Set ptop, ak, bk in fv3 structure
88  fv_atm(1)%ak = conf%ak
89  fv_atm(1)%bk = conf%bk
90  fv_atm(1)%ptop = conf%ptop
91 
92  !Always allocate w, delz, q_con for now
93  deallocate(fv_atm(1)%w)
94  deallocate(fv_atm(1)%delz)
95  deallocate(fv_atm(1)%q_con)
96  allocate ( fv_atm(1)%w (fv_atm(1)%bd%isd:fv_atm(1)%bd%ied,fv_atm(1)%bd%jsd:fv_atm(1)%bd%jed,&
97  fv_atm(1)%flagstruct%npz) )
98  allocate ( fv_atm(1)%delz (fv_atm(1)%bd%isd:fv_atm(1)%bd%ied,fv_atm(1)%bd%jsd:fv_atm(1)%bd%jed,&
99  fv_atm(1)%flagstruct%npz) )
100  allocate ( fv_atm(1)%q_con(fv_atm(1)%bd%isd:fv_atm(1)%bd%ied,fv_atm(1)%bd%jsd:fv_atm(1)%bd%jed,&
101  fv_atm(1)%flagstruct%npz) )
102  fv_atm(1)%w = 0.0_kind_real
103  fv_atm(1)%delz = 0.0_kind_real
104  fv_atm(1)%q_con = 0.0_kind_real
105 
106  f_coriolis_angle = 0.0_kind_real
107 
108  !fC and f0
109  if (fv_atm(1)%flagstruct%grid_type == 4) then
110  fv_atm(1)%gridstruct%fC(:,:) = 2.0_kind_real*omega*sin(fv_atm(1)%flagstruct%deglat/180.0_kind_real*pi)
111  fv_atm(1)%gridstruct%f0(:,:) = 2.0_kind_real*omega*sin(fv_atm(1)%flagstruct%deglat/180.0_kind_real*pi)
112  else
113  if (f_coriolis_angle == -999.0_kind_real) then
114  fv_atm(1)%gridstruct%fC(:,:) = 0.0_kind_real
115  fv_atm(1)%gridstruct%f0(:,:) = 0.0_kind_real
116  else
117  do j=fv_atm(1)%bd%jsd,fv_atm(1)%bd%jed+1
118  do i=fv_atm(1)%bd%isd,fv_atm(1)%bd%ied+1
119  fv_atm(1)%gridstruct%fC(i,j) = 2.0_kind_real*omega*( -cos(fv_atm(1)%gridstruct%grid(i,j,1))*&
120  cos(fv_atm(1)%gridstruct%grid(i,j,2))*sin(f_coriolis_angle) + &
121  sin(fv_atm(1)%gridstruct%grid(i,j,2))*cos(f_coriolis_angle) )
122  enddo
123  enddo
124  do j=fv_atm(1)%bd%jsd,fv_atm(1)%bd%jed
125  do i=fv_atm(1)%bd%isd,fv_atm(1)%bd%ied
126  fv_atm(1)%gridstruct%f0(i,j) = 2.0_kind_real*omega*( -cos(fv_atm(1)%gridstruct%agrid(i,j,1))*&
127  cos(fv_atm(1)%gridstruct%agrid(i,j,2))*sin(f_coriolis_angle) + &
128  sin(fv_atm(1)%gridstruct%agrid(i,j,2))*cos(f_coriolis_angle) )
129  enddo
130  enddo
131  endif
132  endif
133 
134  !Pointer to self when not nested
135  if (.not. fv_atm(1)%gridstruct%nested) fv_atm(1)%parent_grid => fv_atm(1)
136 
137  !Harwire some flags
138  fv_atm(1)%flagstruct%reproduce_sum = .false.
139  fv_atm(1)%flagstruct%fill = .false.
140  fv_atm(1)%flagstruct%fv_debug = .false.
141  fv_atm(1)%flagstruct%adiabatic = .false.
142  fv_atm(1)%flagstruct%do_sat_adj = .false.
143  fv_atm(1)%flagstruct%breed_vortex_inline = .false.
144 
145  !Initialze the perturbation fv3 structure
146  call fv_init_pert(self%FV_Atm,self%FV_AtmP)
147 
148  !Not using field_table here to allocate q based on hardwiring
149  deallocate(fv_atm(1)%q,self%FV_AtmP(1)%qp)
150  if (conf%do_phy_mst == 0) then
151  fv_atm(1)%ncnst = 4
152  else
153  fv_atm(1)%ncnst = 5
154  endif
155 
156  fv_atm(1)%flagstruct%ncnst = fv_atm(1)%ncnst
157  allocate( fv_atm(1)%q (fv_atm(1)%bd%isd:fv_atm(1)%bd%ied,fv_atm(1)%bd%jsd:fv_atm(1)%bd%jed,fv_atm(1)%flagstruct%npz,fv_atm(1)%ncnst))
158  allocate(self%FV_AtmP(1)%qp(fv_atm(1)%bd%isd:fv_atm(1)%bd%ied,fv_atm(1)%bd%jsd:fv_atm(1)%bd%jed,fv_atm(1)%flagstruct%npz,fv_atm(1)%ncnst))
159 
160  !Global
161  cp_iter_controls%cp_i = 0
162  cp_iter_controls%cp_nt = 4
163  cp_iter_controls%cp_gb = -0.1
164  cp_iter_controls%cp_nm = 1
165  call initialize_cp_iter
166 
167  if (cp_iter_controls%cp_i .ne. 0) then
168 
169  !Dynamics
170  self%cp_dyn_ind = 1
171  cp_iter(self%cp_dyn_ind)%my_name(1:3) = 'dyn'
172 
173  cp_iter(self%cp_dyn_ind)%cp_test = .false.
174  tmp = 0
175  if (tmp==1) cp_iter(self%cp_dyn_ind)%cp_test = .true.
176 
177  cp_iter(self%cp_dyn_ind)%cp_rep = .false.
178  tmp = 0
179  if (tmp==1) cp_iter(self%cp_dyn_ind)%cp_test = .true.
180 
181  !Hardwire these for now
182  cp_iter(self%cp_dyn_ind)%check_st_control = .false.
183  cp_iter(self%cp_dyn_ind)%check_st_integer = .false.
184  cp_iter(self%cp_dyn_ind)%check_st_real_r4 = .false.
185  cp_iter(self%cp_dyn_ind)%check_st_real_r8 = .false.
186 
187  cp_iter(self%cp_dyn_ind)%test_dim_st_control = 0
188  cp_iter(self%cp_dyn_ind)%test_dim_st_integer = 0
189  cp_iter(self%cp_dyn_ind)%test_dim_st_real_r4 = 0
190  cp_iter(self%cp_dyn_ind)%test_dim_st_real_r8 = 0
191 
192  cp_iter(self%cp_dyn_ind)%test_dim_cp_control = 0
193  cp_iter(self%cp_dyn_ind)%test_dim_cp_integer = 0
194  cp_iter(self%cp_dyn_ind)%test_dim_cp_real_r4 = 0
195  cp_iter(self%cp_dyn_ind)%test_dim_cp_real_r8 = 0
196 
197  endif
198 
199  !Convenience
200  self%isc = fv_atm(1)%bd%isc
201  self%iec = fv_atm(1)%bd%iec
202  self%jsc = fv_atm(1)%bd%jsc
203  self%jec = fv_atm(1)%bd%jec
204  self%isd = fv_atm(1)%bd%isd
205  self%ied = fv_atm(1)%bd%ied
206  self%jsd = fv_atm(1)%bd%jsd
207  self%jed = fv_atm(1)%bd%jed
208  self%npz = fv_atm(1)%npz
209 
210  conf%rpe = .false.
211  if (mpp_pe() == mpp_root_pe()) conf%rpe = .true.
212 
213 endsubroutine create
214 
215 ! ------------------------------------------------------------------------------
216 
217 subroutine init_nl(self,conf,pert,traj)
219  implicit none
220 
221  class(fv3jedi_lm_dynamics_type), intent(inout) :: self
222  type(fv3jedi_lm_conf), intent(in) :: conf
223  type(fv3jedi_lm_pert), intent(inout) :: pert
224  type(fv3jedi_lm_traj), intent(in) :: traj
225 
226 endsubroutine init_nl
227 
228 ! ------------------------------------------------------------------------------
229 
230 subroutine init_tl(self,conf,pert,traj)
232  implicit none
233 
234  class(fv3jedi_lm_dynamics_type), intent(inout) :: self
235  type(fv3jedi_lm_conf), intent(in) :: conf
236  type(fv3jedi_lm_pert), intent(inout) :: pert
237  type(fv3jedi_lm_traj), intent(in) :: traj
238 
239 endsubroutine init_tl
240 
241 ! ------------------------------------------------------------------------------
242 
243 subroutine init_ad(self,conf,pert,traj)
245  implicit none
246 
247  class(fv3jedi_lm_dynamics_type), intent(inout) :: self
248  type(fv3jedi_lm_conf), intent(in) :: conf
249  type(fv3jedi_lm_pert), intent(inout) :: pert
250  type(fv3jedi_lm_traj), intent(in) :: traj
251 
252 endsubroutine init_ad
253 
254 ! ------------------------------------------------------------------------------
255 
256 subroutine step_nl(self,conf,traj)
258  implicit none
259 
260  class(fv3jedi_lm_dynamics_type), intent(inout), target :: self
261  type(fv3jedi_lm_traj), intent(inout) :: traj
262  type(fv3jedi_lm_conf), intent(in) :: conf
263 
264  type(fv_atmos_type), pointer :: FV_Atm(:)
265  integer :: i,j,k
266 
267 
268  !Convenience pointer to the main FV_Atm structure
269  !------------------------------------------------
270  fv_atm => self%FV_Atm
271 
272 
273  !Copy from traj to the fv3 structure
274  !-----------------------------------
275  call traj_to_fv3(self,conf,traj)
276 
277 
278  ! MPP set domain
279  ! --------------
280  call set_domain(fv_atm(1)%domain)
281 
282 
283  !Propagate FV3 one time step
284  !---------------------------
285  if (self%linmodtest == 0) then
286  call fv_dynamics( fv_atm(1)%npx, fv_atm(1)%npy, fv_atm(1)%npz, fv_atm(1)%ncnst, fv_atm(1)%ng, &
287  conf%DT, fv_atm(1)%flagstruct%consv_te, fv_atm(1)%flagstruct%fill, &
288  fv_atm(1)%flagstruct%reproduce_sum, kappa, &
289  cp, zvir, fv_atm(1)%ptop, fv_atm(1)%ks, fv_atm(1)%flagstruct%ncnst, &
290  fv_atm(1)%flagstruct%n_split, fv_atm(1)%flagstruct%q_split, &
291  fv_atm(1)%u, fv_atm(1)%v, fv_atm(1)%w, fv_atm(1)%delz, &
292  fv_atm(1)%flagstruct%hydrostatic, fv_atm(1)%pt, fv_atm(1)%delp, fv_atm(1)%q, &
293  fv_atm(1)%ps, fv_atm(1)%pe, fv_atm(1)%pk, fv_atm(1)%peln, fv_atm(1)%pkz, &
294  fv_atm(1)%phis, fv_atm(1)%q_con, fv_atm(1)%omga, &
295  fv_atm(1)%ua, fv_atm(1)%va, fv_atm(1)%uc, fv_atm(1)%vc, &
296  fv_atm(1)%ak, fv_atm(1)%bk, &
297  fv_atm(1)%mfx, fv_atm(1)%mfy, fv_atm(1)%cx, fv_atm(1)%cy, fv_atm(1)%ze0, &
298  fv_atm(1)%flagstruct%hybrid_z, fv_atm(1)%gridstruct, fv_atm(1)%flagstruct, &
299  fv_atm(1)%neststruct, fv_atm(1)%idiag, fv_atm(1)%bd, fv_atm(1)%parent_grid, &
300  fv_atm(1)%domain )
301  else
302  call fv_dynamics_nlm( fv_atm(1)%npx, fv_atm(1)%npy, fv_atm(1)%npz, fv_atm(1)%ncnst, fv_atm(1)%ng, &
303  conf%DT, fv_atm(1)%flagstruct%consv_te, fv_atm(1)%flagstruct%fill, &
304  fv_atm(1)%flagstruct%reproduce_sum, kappa, &
305  cp, zvir, fv_atm(1)%ptop, fv_atm(1)%ks, fv_atm(1)%flagstruct%ncnst, &
306  fv_atm(1)%flagstruct%n_split, fv_atm(1)%flagstruct%q_split, &
307  fv_atm(1)%u, fv_atm(1)%v, fv_atm(1)%w, fv_atm(1)%delz, &
308  fv_atm(1)%flagstruct%hydrostatic, fv_atm(1)%pt, fv_atm(1)%delp, fv_atm(1)%q, &
309  fv_atm(1)%ps, fv_atm(1)%pe, fv_atm(1)%pk, fv_atm(1)%peln, fv_atm(1)%pkz, &
310  fv_atm(1)%phis, fv_atm(1)%q_con, fv_atm(1)%omga, &
311  fv_atm(1)%ua, fv_atm(1)%va, fv_atm(1)%uc, fv_atm(1)%vc, &
312  fv_atm(1)%ak, fv_atm(1)%bk, &
313  fv_atm(1)%mfx, fv_atm(1)%mfy, fv_atm(1)%cx, fv_atm(1)%cy, fv_atm(1)%ze0, &
314  fv_atm(1)%flagstruct%hybrid_z, fv_atm(1)%gridstruct, fv_atm(1)%flagstruct, &
315  self%FV_AtmP(1)%flagstruct, &
316  fv_atm(1)%neststruct, fv_atm(1)%idiag, fv_atm(1)%bd, fv_atm(1)%parent_grid, &
317  fv_atm(1)%domain )
318  endif
319 
320 
321  ! MPP nulify
322  ! ----------
323  call nullify_domain()
324 
325 
326  !Copy from fv3 back to traj structure
327  !------------------------------------
328  call fv3_to_traj(self,conf,traj)
329 
330 
331 endsubroutine step_nl
332 
333 ! ------------------------------------------------------------------------------
334 
335 subroutine step_tl(self,conf,traj,pert)
337  implicit none
338 
339  class(fv3jedi_lm_dynamics_type), target, intent(inout) :: self
340  type(fv3jedi_lm_conf), intent(in) :: conf
341  type(fv3jedi_lm_traj), intent(in) :: traj
342  type(fv3jedi_lm_pert), intent(inout) :: pert
343 
344  type(fv_atmos_type), pointer :: FV_Atm(:)
345  type(fv_atmos_pert_type), pointer :: FV_AtmP(:)
346  integer :: i,j,k
347 
348 
349  !Convenience pointer to the main FV_Atm structure
350  !------------------------------------------------
351  fv_atm => self%FV_Atm
352  fv_atmp => self%FV_AtmP
353 
354 
355  ! Set diagnostics to zeros
356  ! ------------------------
357  call zero_pert_vars(fv_atmp(1))
358 
359 
360  !Copy from traj/pert to the fv3 structures
361  !-----------------------------------------
362  call traj_to_fv3(self,conf,traj)
363  call pert_to_fv3(self,conf,pert)
364 
365 
366  !A-grid winds are diagnostic
367  !---------------------------
368  fv_atmp(1)%uap = 0.0
369  fv_atmp(1)%vap = 0.0
370 
371 
372  !Edge of pert always needs to be filled
373  !--------------------------------------
374  call mpp_get_boundary( fv_atmp(1)%up, fv_atmp(1)%vp, fv_atm(1)%domain, &
375  wbuffery=self%wbuffery, ebuffery=self%ebuffery, &
376  sbufferx=self%sbufferx, nbufferx=self%nbufferx, &
377  gridtype=dgrid_ne, complete=.true. )
378  do k=1,self%npz
379  do i=self%isc,self%iec
380  fv_atmp(1)%up(i,self%jec+1,k) = self%nbufferx(i,k)
381  enddo
382  enddo
383  do k=1,self%npz
384  do j=self%jsc,self%jec
385  fv_atmp(1)%vp(self%iec+1,j,k) = self%ebuffery(j,k)
386  enddo
387  enddo
388 
389 
390  !Compute the other pressure variables needed by FV3
391  !--------------------------------------------------
392  call compute_fv3_pressures_tlm( self%isc, self%iec, self%jsc, self%jec, &
393  self%isd, self%ied, self%jsd, self%jed, &
394  self%npz, kappa, fv_atm(1)%ptop, &
395  fv_atm(1)%delp, fv_atmp(1)%delpp, &
396  fv_atm(1)%pe, fv_atmp(1)%pep, &
397  fv_atm(1)%pk, fv_atmp(1)%pkp, &
398  fv_atm(1)%pkz, fv_atmp(1)%pkzp, &
399  fv_atm(1)%peln, fv_atmp(1)%pelnp )
400 
401 
402  ! MPP set domain
403  ! --------------
404  call set_domain(fv_atm(1)%domain)
405 
406 
407  !Propagate TLM one time step
408  !---------------------------
409  call fv_dynamics_tlm(fv_atm(1)%npx, fv_atm(1)%npy, fv_atm(1)%npz, fv_atm(1)%ncnst, fv_atm(1)%ng, &
410  conf%DT, fv_atm(1)%flagstruct%consv_te, fv_atm(1)%flagstruct%fill, &
411  fv_atm(1)%flagstruct%reproduce_sum, kappa, &
412  cp, zvir, fv_atm(1)%ptop, fv_atm(1)%ks, fv_atm(1)%flagstruct%ncnst, &
413  fv_atm(1)%flagstruct%n_split, fv_atm(1)%flagstruct%q_split, &
414  fv_atm(1)%u, fv_atmp(1)%up, fv_atm(1)%v, fv_atmp(1)%vp, fv_atm(1)%w, fv_atmp(1)%wp, &
415  fv_atm(1)%delz, fv_atmp(1)%delzp, fv_atm(1)%flagstruct%hydrostatic, &
416  fv_atm(1)%pt, fv_atmp(1)%ptp, fv_atm(1)%delp, fv_atmp(1)%delpp, &
417  fv_atm(1)%q, fv_atmp(1)%qp, fv_atm(1)%ps, fv_atmp(1)%psp, fv_atm(1)%pe, fv_atmp(1)%pep, &
418  fv_atm(1)%pk, fv_atmp(1)%pkp, fv_atm(1)%peln, fv_atmp(1)%pelnp, fv_atm(1)%pkz, fv_atmp(1)%pkzp, &
419  fv_atm(1)%phis, fv_atm(1)%q_con, fv_atm(1)%omga, fv_atmp(1)%omgap, &
420  fv_atm(1)%ua, fv_atmp(1)%uap, fv_atm(1)%va, fv_atmp(1)%vap, &
421  fv_atm(1)%uc, fv_atmp(1)%ucp, fv_atm(1)%vc, fv_atmp(1)%vcp, &
422  fv_atm(1)%ak, fv_atm(1)%bk, &
423  fv_atm(1)%mfx, fv_atmp(1)%mfxp, fv_atm(1)%mfy, fv_atmp(1)%mfyp, &
424  fv_atm(1)%cx, fv_atmp(1)%cxp, fv_atm(1)%cy, fv_atmp(1)%cyp, fv_atm(1)%ze0, &
425  fv_atm(1)%flagstruct%hybrid_z, fv_atm(1)%gridstruct, fv_atm(1)%flagstruct, fv_atmp(1)%flagstruct, &
426  fv_atm(1)%neststruct, fv_atm(1)%idiag, fv_atm(1)%bd, fv_atm(1)%parent_grid,fv_atm(1)%domain )
427 
428 
429  ! MPP nulify
430  ! ----------
431  call nullify_domain()
432 
433 
434  !Copy from fv3 back to pert structure
435  !------------------------------------
436  call fv3_to_pert(self,conf,pert)
437 
438 
439  ! Set diagnostics to zeros
440  ! ------------------------
441  call zero_pert_vars(fv_atmp(1))
442 
443 
444 endsubroutine step_tl
445 
446 ! ------------------------------------------------------------------------------
447 
448 subroutine step_ad(self,conf,traj,pert)
450  implicit none
451 
452  class(fv3jedi_lm_dynamics_type), target, intent(inout) :: self
453  type(fv3jedi_lm_conf), intent(in) :: conf
454  type(fv3jedi_lm_traj), intent(in) :: traj
455  type(fv3jedi_lm_pert), intent(inout) :: pert
456 
457  type(fv_atmos_type), pointer :: FV_Atm(:)
458  type(fv_atmos_pert_type), pointer :: FV_AtmP(:)
459  integer :: i,j,k
460 
461 
462  !Convenience pointer to the main FV_Atm structure
463  !------------------------------------------------
464  fv_atm => self%FV_Atm
465  fv_atmp => self%FV_AtmP
466 
467 
468  ! Set diagnostics to zeros
469  ! ------------------------
470  call zero_pert_vars(fv_atmp(1))
471 
472 
473  !Copy from traj/pert to the fv3 structures
474  !-----------------------------------------
475  call traj_to_fv3(self,conf,traj)
476  call pert_to_fv3(self,conf,pert)
477 
478 
479  ! MPP set domain
480  ! --------------
481  call set_domain(fv_atm(1)%domain)
482 
483 
484  ! Initilize the module level checkpointing
485  ! ----------------------------------------
486  if (cp_iter_controls%cp_i .ne. 0) then
487  call cp_mod_ini(self%cp_dyn_ind)
488  endif
489 
490 
491  ! Forward sweep of the dynamics with saving of checkpoints for use in backward sweep
492  ! ----------------------------------------------------------------------------------
493  if (cp_iter_controls%cp_i <= 3) then
494 
495  call fv_dynamics_fwd(fv_atm(1)%npx, fv_atm(1)%npy, fv_atm(1)%npz, fv_atm(1)%ncnst, fv_atm(1)%ng, &
496  conf%DT, fv_atm(1)%flagstruct%consv_te, fv_atm(1)%flagstruct%fill, &
497  fv_atm(1)%flagstruct%reproduce_sum, kappa, &
498  cp, zvir, fv_atm(1)%ptop, fv_atm(1)%ks, fv_atm(1)%flagstruct%ncnst, &
499  fv_atm(1)%flagstruct%n_split, fv_atm(1)%flagstruct%q_split, &
500  fv_atm(1)%u, fv_atm(1)%v, fv_atm(1)%w, &
501  fv_atm(1)%delz, fv_atm(1)%flagstruct%hydrostatic, &
502  fv_atm(1)%pt, fv_atm(1)%delp, &
503  fv_atm(1)%q, fv_atm(1)%ps, fv_atm(1)%pe, &
504  fv_atm(1)%pk, fv_atm(1)%peln, fv_atm(1)%pkz, &
505  fv_atm(1)%phis, fv_atm(1)%q_con, fv_atm(1)%omga, &
506  fv_atm(1)%ua, fv_atm(1)%va, &
507  fv_atm(1)%uc, fv_atm(1)%vc, &
508  fv_atm(1)%ak, fv_atm(1)%bk, &
509  fv_atm(1)%mfx, fv_atm(1)%mfy, &
510  fv_atm(1)%cx, fv_atm(1)%cy, fv_atm(1)%ze0, &
511  fv_atm(1)%flagstruct%hybrid_z, fv_atm(1)%gridstruct, fv_atm(1)%flagstruct, &
512  fv_atmp(1)%flagstruct, &
513  fv_atm(1)%neststruct, fv_atm(1)%idiag, fv_atm(1)%bd, fv_atm(1)%parent_grid,fv_atm(1)%domain )
514 
515  if (cp_iter_controls%cp_i .ne. 0) then
516  !Push end of timestep trajectory to stack
517  call pushrealarray(fv_atm(1)%u ,(self%ied-self%isd+1)*(self%jed-self%jsd+2)*self%npz)
518  call pushrealarray(fv_atm(1)%v ,(self%ied-self%isd+2)*(self%jed-self%jsd+1)*self%npz)
519  call pushrealarray(fv_atm(1)%w ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
520  call pushrealarray(fv_atm(1)%delz,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
521  call pushrealarray(fv_atm(1)%pt ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
522  call pushrealarray(fv_atm(1)%delp,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
523  call pushrealarray(fv_atm(1)%q ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz*fv_atm(1)%ncnst)
524  call pushrealarray(fv_atm(1)%ps ,(self%ied-self%isd+1)*(self%jed-self%jsd+1))
525  call pushrealarray(fv_atm(1)%pe ,(self%iec-self%isc+3)*(self%jec-self%jsc+3)*(self%npz+1))
526  call pushrealarray(fv_atm(1)%pk ,(self%iec-self%isc+1)*(self%jec-self%jsc+1)*(self%npz+1))
527  call pushrealarray(fv_atm(1)%peln,(self%iec-self%isc+1)*(self%jec-self%jsc+1)*(self%npz+1))
528  call pushrealarray(fv_atm(1)%pkz ,(self%iec-self%isc+1)*(self%jec-self%jsc+1)*self%npz)
529  call pushrealarray(fv_atm(1)%phis,(self%ied-self%isd+1)*(self%jed-self%jsd+1))
530  call pushrealarray(fv_atm(1)%omga,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
531  call pushrealarray(fv_atm(1)%ua ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
532  call pushrealarray(fv_atm(1)%va ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
533  call pushrealarray(fv_atm(1)%uc ,(self%ied-self%isd+2)*(self%jed-self%jsd+1)*self%npz)
534  call pushrealarray(fv_atm(1)%vc ,(self%ied-self%isd+1)*(self%jed-self%jsd+2)*self%npz)
535  call pushrealarray(fv_atm(1)%mfx ,(self%iec-self%isc+2)*(self%jec-self%jsc+1)*self%npz)
536  call pushrealarray(fv_atm(1)%mfy ,(self%iec-self%isc+1)*(self%jec-self%jsc+2)*self%npz)
537  call pushrealarray(fv_atm(1)%cx ,(self%iec-self%isc+2)*(self%jed-self%jsd+1)*self%npz)
538  call pushrealarray(fv_atm(1)%cy ,(self%ied-self%isd+1)*(self%jec-self%jsc+2)*self%npz)
539  !Trick checkpoint schemes into not considering these superfluous checkpoints,
540  !about to recover with the pop anyway.
541  fv_atm(1)%u = 2.0_kind_real*fv_atm(1)%u
542  fv_atm(1)%v = 2.0_kind_real*fv_atm(1)%v
543  fv_atm(1)%w = 2.0_kind_real*fv_atm(1)%w
544  fv_atm(1)%delz = 2.0_kind_real*fv_atm(1)%delz
545  fv_atm(1)%pt = 2.0_kind_real*fv_atm(1)%pt
546  fv_atm(1)%delp = 2.0_kind_real*fv_atm(1)%delp
547  fv_atm(1)%q = 2.0_kind_real*fv_atm(1)%q
548  fv_atm(1)%ps = 2.0_kind_real*fv_atm(1)%ps
549  fv_atm(1)%pe = 2.0_kind_real*fv_atm(1)%pe
550  fv_atm(1)%pk = 2.0_kind_real*fv_atm(1)%pk
551  fv_atm(1)%peln = 2.0_kind_real*fv_atm(1)%peln
552  fv_atm(1)%pkz = 2.0_kind_real*fv_atm(1)%pkz
553  fv_atm(1)%phis = 2.0_kind_real*fv_atm(1)%phis
554  fv_atm(1)%omga = 2.0_kind_real*fv_atm(1)%omga
555  fv_atm(1)%ua = 2.0_kind_real*fv_atm(1)%ua
556  fv_atm(1)%va = 2.0_kind_real*fv_atm(1)%va
557  fv_atm(1)%uc = 2.0_kind_real*fv_atm(1)%uc
558  fv_atm(1)%vc = 2.0_kind_real*fv_atm(1)%vc
559  fv_atm(1)%mfx = 2.0_kind_real*fv_atm(1)%mfx
560  fv_atm(1)%mfy = 2.0_kind_real*fv_atm(1)%mfy
561  fv_atm(1)%cx = 2.0_kind_real*fv_atm(1)%cx
562  fv_atm(1)%cy = 2.0_kind_real*fv_atm(1)%cy
563  endif
564 
565  endif
566 
567 
568  ! Checkpoint mid point, reset counters etc
569  ! ----------------------------------------
570  if (cp_iter_controls%cp_i .ne. 0) then
571  call cp_mod_mid
572  endif
573 
574  if (cp_iter_controls%cp_i .ne. 0) then
575  !Populate end of timestep trajectory from stack
576  call poprealarray(fv_atm(1)%cy ,(self%ied-self%isd+1)*(self%jec-self%jsc+2)*self%npz)
577  call poprealarray(fv_atm(1)%cx ,(self%iec-self%isc+2)*(self%jed-self%jsd+1)*self%npz)
578  call poprealarray(fv_atm(1)%mfy ,(self%iec-self%isc+1)*(self%jec-self%jsc+2)*self%npz)
579  call poprealarray(fv_atm(1)%mfx ,(self%iec-self%isc+2)*(self%jec-self%jsc+1)*self%npz)
580  call poprealarray(fv_atm(1)%vc ,(self%ied-self%isd+1)*(self%jed-self%jsd+2)*self%npz)
581  call poprealarray(fv_atm(1)%uc ,(self%ied-self%isd+2)*(self%jed-self%jsd+1)*self%npz)
582  call poprealarray(fv_atm(1)%va ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
583  call poprealarray(fv_atm(1)%ua ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
584  call poprealarray(fv_atm(1)%omga,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
585  call poprealarray(fv_atm(1)%phis,(self%ied-self%isd+1)*(self%jed-self%jsd+1))
586  call poprealarray(fv_atm(1)%pkz ,(self%iec-self%isc+1)*(self%jec-self%jsc+1)*self%npz)
587  call poprealarray(fv_atm(1)%peln,(self%iec-self%isc+1)*(self%jec-self%jsc+1)*(self%npz+1))
588  call poprealarray(fv_atm(1)%pk ,(self%iec-self%isc+1)*(self%jec-self%jsc+1)*(self%npz+1))
589  call poprealarray(fv_atm(1)%pe ,(self%iec-self%isc+3)*(self%jec-self%jsc+3)*(self%npz+1))
590  call poprealarray(fv_atm(1)%ps ,(self%ied-self%isd+1)*(self%jed-self%jsd+1))
591  call poprealarray(fv_atm(1)%q ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz*fv_atm(1)%ncnst)
592  call poprealarray(fv_atm(1)%delp,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
593  call poprealarray(fv_atm(1)%pt ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
594  call poprealarray(fv_atm(1)%delz,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
595  call poprealarray(fv_atm(1)%w ,(self%ied-self%isd+1)*(self%jed-self%jsd+1)*self%npz)
596  call poprealarray(fv_atm(1)%v ,(self%ied-self%isd+2)*(self%jed-self%jsd+1)*self%npz)
597  call poprealarray(fv_atm(1)%u ,(self%ied-self%isd+1)*(self%jed-self%jsd+2)*self%npz)
598  endif
599 
600 
601  ! Backward adjoint sweep of the dynamics
602  ! --------------------------------------
603  call fv_dynamics_bwd(fv_atm(1)%npx, fv_atm(1)%npy, fv_atm(1)%npz, fv_atm(1)%ncnst, fv_atm(1)%ng, &
604  conf%DT, fv_atm(1)%flagstruct%consv_te, fv_atm(1)%flagstruct%fill, &
605  fv_atm(1)%flagstruct%reproduce_sum, kappa, &
606  cp, zvir, fv_atm(1)%ptop, fv_atm(1)%ks, fv_atm(1)%flagstruct%ncnst, &
607  fv_atm(1)%flagstruct%n_split, fv_atm(1)%flagstruct%q_split, &
608  fv_atm(1)%u, fv_atmp(1)%up, fv_atm(1)%v, fv_atmp(1)%vp, fv_atm(1)%w, fv_atmp(1)%wp, &
609  fv_atm(1)%delz, fv_atmp(1)%delzp, fv_atm(1)%flagstruct%hydrostatic, &
610  fv_atm(1)%pt, fv_atmp(1)%ptp, fv_atm(1)%delp, fv_atmp(1)%delpp, &
611  fv_atm(1)%q, fv_atmp(1)%qp, fv_atm(1)%ps, fv_atmp(1)%psp, fv_atm(1)%pe, fv_atmp(1)%pep, &
612  fv_atm(1)%pk, fv_atmp(1)%pkp, fv_atm(1)%peln, fv_atmp(1)%pelnp, fv_atm(1)%pkz, fv_atmp(1)%pkzp, &
613  fv_atm(1)%phis, fv_atm(1)%q_con, fv_atm(1)%omga, fv_atmp(1)%omgap, &
614  fv_atm(1)%ua, fv_atmp(1)%uap, fv_atm(1)%va, fv_atmp(1)%vap, &
615  fv_atm(1)%uc, fv_atmp(1)%ucp, fv_atm(1)%vc, fv_atmp(1)%vcp, &
616  fv_atm(1)%ak, fv_atm(1)%bk, &
617  fv_atm(1)%mfx, fv_atmp(1)%mfxp, fv_atm(1)%mfy, fv_atmp(1)%mfyp, &
618  fv_atm(1)%cx, fv_atmp(1)%cxp, fv_atm(1)%cy, fv_atmp(1)%cyp, fv_atm(1)%ze0, &
619  fv_atm(1)%flagstruct%hybrid_z, fv_atm(1)%gridstruct, fv_atm(1)%flagstruct, &
620  fv_atmp(1)%flagstruct, &
621  fv_atm(1)%neststruct, fv_atm(1)%idiag, fv_atm(1)%bd, fv_atm(1)%parent_grid,fv_atm(1)%domain )
622 
623 
624  !Adjoint of compute the other pressure variables needed by FV3
625  !-------------------------------------------------------------
626  call compute_fv3_pressures_bwd( self%isc, self%iec, self%jsc, self%jec, &
627  self%isd, self%ied, self%jsd, self%jed, &
628  self%npz, kappa, fv_atm(1)%ptop, &
629  fv_atm(1)%delp, fv_atmp(1)%delpp, &
630  fv_atm(1)%pe, fv_atmp(1)%pep, &
631  fv_atm(1)%pk, fv_atmp(1)%pkp, &
632  fv_atm(1)%pkz, fv_atmp(1)%pkzp, &
633  fv_atm(1)%peln, fv_atmp(1)%pelnp )
634 
635 
636  !Edge of pert always needs to be filled
637  !--------------------------------------
638  self%nbufferx = 0.0_kind_real
639  do k=1,self%npz
640  do i=self%isc,self%iec
641  self%nbufferx(i,k) = fv_atmp(1)%up(i,self%jec+1,k)
642  enddo
643  enddo
644  self%ebuffery = 0.0_kind_real
645  do k=1,self%npz
646  do j=self%jsc,self%jec
647  self%ebuffery(j,k) = fv_atmp(1)%vp(self%iec+1,j,k)
648  enddo
649  enddo
650 
651  call mpp_get_boundary_ad( fv_atmp(1)%up, fv_atmp(1)%vp, fv_atm(1)%domain, &
652  wbuffery=self%wbuffery, ebuffery=self%ebuffery, sbufferx=self%sbufferx, nbufferx=self%nbufferx, &
653  gridtype=dgrid_ne, complete=.true. )
654 
655 
656  ! MPP nulify
657  ! ----------
658  call nullify_domain()
659 
660 
661  !A-grid winds are diagnostic
662  !---------------------------
663  fv_atmp(1)%uap = 0.0
664  fv_atmp(1)%vap = 0.0
665 
666 
667  !Copy from fv3 back to pert structure
668  !------------------------------------
669  call fv3_to_pert(self,conf,pert)
670 
671 
672  ! Set diagnostics to zeros
673  ! ------------------------
674  call zero_pert_vars(fv_atmp(1))
675 
676 
677 endsubroutine step_ad
678 
679 ! ------------------------------------------------------------------------------
680 
681 subroutine delete(self,conf)
683  implicit none
684 
685  class(fv3jedi_lm_dynamics_type), intent(inout) :: self
686  type(fv3jedi_lm_conf), intent(in) :: conf
687 
688  deallocate(self%ebuffery)
689  deallocate(self%wbuffery)
690  deallocate(self%nbufferx)
691  deallocate(self%sbufferx)
692 
693  call deallocate_fv_atmos_type(self%FV_Atm(1))
694  deallocate(self%FV_Atm)
695 
696  call deallocate_fv_atmos_pert_type(self%FV_AtmP(1))
697  deallocate(self%FV_AtmP)
698 
699  if (cp_iter_controls%cp_i .ne. 0) call finalize_cp_iter
700 
701 endsubroutine delete
702 
703 ! ------------------------------------------------------------------------------
704 
705 subroutine traj_to_fv3(self,conf,traj)
707  implicit none
708 
709  class(fv3jedi_lm_dynamics_type), intent(inout) :: self
710  type(fv3jedi_lm_conf), intent(in) :: conf
711  type(fv3jedi_lm_traj), intent(in) :: traj
712 
713  integer :: i,j,k
714 
715 
716  !Zero the halos
717  !--------------
718  self%FV_Atm(1)%u = 0.0_kind_real
719  self%FV_Atm(1)%v = 0.0_kind_real
720  self%FV_Atm(1)%pt = 0.0_kind_real
721  self%FV_Atm(1)%delp = 0.0_kind_real
722  self%FV_Atm(1)%q = 0.0_kind_real
723  self%FV_Atm(1)%w = 0.0_kind_real
724  self%FV_Atm(1)%delz = 0.0_kind_real
725  self%FV_Atm(1)%phis = 0.0_kind_real
726  self%FV_Atm(1)%pe = 0.0_kind_real
727  self%FV_Atm(1)%peln = 0.0_kind_real
728  self%FV_Atm(1)%pk = 0.0_kind_real
729  self%FV_Atm(1)%pkz = 0.0_kind_real
730  self%FV_Atm(1)%ua = 0.0_kind_real
731  self%FV_Atm(1)%va = 0.0_kind_real
732  self%FV_Atm(1)%uc = 0.0_kind_real
733  self%FV_Atm(1)%vc = 0.0_kind_real
734  self%FV_Atm(1)%omga = 0.0_kind_real
735  self%FV_Atm(1)%mfx = 0.0_kind_real
736  self%FV_Atm(1)%mfy = 0.0_kind_real
737  self%FV_Atm(1)%cx = 0.0_kind_real
738  self%FV_Atm(1)%cy = 0.0_kind_real
739  self%FV_Atm(1)%ze0 = 0.0_kind_real
740  self%FV_Atm(1)%q_con = 0.0_kind_real
741  self%FV_Atm(1)%ps = 0.0_kind_real
742 
743 
744  !Copy from traj
745  !--------------
746  self%FV_Atm(1)%u (self%isc:self%iec,self%jsc:self%jec,:) = traj%u (self%isc:self%iec,self%jsc:self%jec,:)
747  self%FV_Atm(1)%v (self%isc:self%iec,self%jsc:self%jec,:) = traj%v (self%isc:self%iec,self%jsc:self%jec,:)
748  self%FV_Atm(1)%pt (self%isc:self%iec,self%jsc:self%jec,:) = traj%t (self%isc:self%iec,self%jsc:self%jec,:)
749  self%FV_Atm(1)%delp(self%isc:self%iec,self%jsc:self%jec,:) = traj%delp(self%isc:self%iec,self%jsc:self%jec,:)
750 
751  self%FV_Atm(1)%q(self%isc:self%iec,self%jsc:self%jec,:,1) = traj%qv(self%isc:self%iec,self%jsc:self%jec,:)
752  self%FV_Atm(1)%q(self%isc:self%iec,self%jsc:self%jec,:,2) = traj%ql(self%isc:self%iec,self%jsc:self%jec,:)
753  self%FV_Atm(1)%q(self%isc:self%iec,self%jsc:self%jec,:,3) = traj%qi(self%isc:self%iec,self%jsc:self%jec,:)
754  self%FV_Atm(1)%q(self%isc:self%iec,self%jsc:self%jec,:,4) = traj%o3(self%isc:self%iec,self%jsc:self%jec,:)
755 
756  if (conf%do_phy_mst .ne. 0) then
757  self%FV_Atm(1)%q(self%isc:self%iec,self%jsc:self%jec,:,5) = traj%cfcn(self%isc:self%iec,self%jsc:self%jec,:)
758  endif
759 
760  if (.not. self%FV_Atm(1)%flagstruct%hydrostatic) then
761  self%FV_Atm(1)%delz(self%isc:self%iec ,self%jsc:self%jec ,: ) = traj%delz(self%isc:self%iec ,self%jsc:self%jec ,: )
762  self%FV_Atm(1)%w (self%isc:self%iec ,self%jsc:self%jec ,: ) = traj%w (self%isc:self%iec ,self%jsc:self%jec ,: )
763  endif
764 
765  self%FV_Atm(1)%phis(self%isc:self%iec,self%jsc:self%jec) = traj%phis(self%isc:self%iec,self%jsc:self%jec)
766 
767 
768  !Update edges of d-grid winds
769  !----------------------------
770  call mpp_get_boundary(self%FV_Atm(1)%u, self%FV_Atm(1)%v, self%FV_Atm(1)%domain, &
771  wbuffery=self%wbuffery, ebuffery=self%ebuffery, &
772  sbufferx=self%sbufferx, nbufferx=self%nbufferx, &
773  gridtype=dgrid_ne, complete=.true. )
774  do k=1,self%npz
775  do i=self%isc,self%iec
776  self%FV_Atm(1)%u(i,self%jec+1,k) = self%nbufferx(i,k)
777  enddo
778  enddo
779  do k=1,self%npz
780  do j=self%jsc,self%jec
781  self%FV_Atm(1)%v(self%iec+1,j,k) = self%ebuffery(j,k)
782  enddo
783  enddo
784 
785 
786  ! Fill phi halos
787  ! --------------
788  call mpp_update_domains(self%FV_Atm(1)%phis, self%FV_Atm(1)%domain, complete=.true.)
789 
790 
791  !Compute the other pressure variables needed by FV3
792  !--------------------------------------------------
793  call compute_fv3_pressures( self%isc, self%iec, self%jsc, self%jec, self%isd, self%ied, self%jsd, self%jed, &
794  self%npz, kappa, self%FV_Atm(1)%ptop, &
795  self%FV_Atm(1)%delp, self%FV_Atm(1)%pe, self%FV_Atm(1)%pk, self%FV_Atm(1)%pkz, self%FV_Atm(1)%peln )
796 
797 endsubroutine traj_to_fv3
798 
799 ! ------------------------------------------------------------------------------
800 
801 subroutine fv3_to_traj(self,conf,traj)
803  implicit none
804 
805  class(fv3jedi_lm_dynamics_type), intent(in) :: self
806  type(fv3jedi_lm_conf), intent(in) :: conf
807  type(fv3jedi_lm_traj), intent(inout) :: traj
808 
809  traj%u (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%u (self%isc:self%iec,self%jsc:self%jec,:)
810  traj%v (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%v (self%isc:self%iec,self%jsc:self%jec,:)
811  traj%t (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%pt (self%isc:self%iec,self%jsc:self%jec,:)
812  traj%delp(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%delp(self%isc:self%iec,self%jsc:self%jec,:)
813  traj%qv (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%q (self%isc:self%iec,self%jsc:self%jec,:,1)
814  traj%ql (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%q (self%isc:self%iec,self%jsc:self%jec,:,2)
815  traj%qi (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%q (self%isc:self%iec,self%jsc:self%jec,:,3)
816  traj%o3 (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%q (self%isc:self%iec,self%jsc:self%jec,:,4)
817 
818  if (conf%do_phy_mst .ne. 0) then
819  traj%cfcn(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%q(self%isc:self%iec,self%jsc:self%jec,:,5)
820  endif
821 
822  if (.not. self%FV_Atm(1)%flagstruct%hydrostatic) then
823  traj%delz(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%delz(self%isc:self%iec,self%jsc:self%jec,:)
824  traj%w (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%w (self%isc:self%iec,self%jsc:self%jec,:)
825  endif
826 
827  traj%ua(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%ua(self%isc:self%iec,self%jsc:self%jec,:)
828  traj%va(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_Atm(1)%va(self%isc:self%iec,self%jsc:self%jec,:)
829 
830  traj%phis(self%isc:self%iec,self%jsc:self%jec) = self%FV_Atm(1)%phis(self%isc:self%iec,self%jsc:self%jec)
831 
832 endsubroutine fv3_to_traj
833 
834 ! ------------------------------------------------------------------------------
835 
836 subroutine pert_to_fv3(self,conf,pert)
838  implicit none
839 
840  class(fv3jedi_lm_dynamics_type), intent(inout) :: self
841  type(fv3jedi_lm_conf), intent(in) :: conf
842  type(fv3jedi_lm_pert), intent(in) :: pert
843 
844  !To zero the halos
845  self%FV_AtmP(1)%up = 0.0
846  self%FV_AtmP(1)%vp = 0.0
847  self%FV_AtmP(1)%ptp = 0.0
848  self%FV_AtmP(1)%delpp = 0.0
849  self%FV_AtmP(1)%qp = 0.0
850  self%FV_AtmP(1)%wp = 0.0
851  self%FV_AtmP(1)%delzp = 0.0
852  self%FV_AtmP(1)%uap = 0.0
853  self%FV_AtmP(1)%vap = 0.0
854 
855  self%FV_AtmP(1)%up (self%isc:self%iec,self%jsc:self%jec,:) = pert%u (self%isc:self%iec,self%jsc:self%jec,:)
856  self%FV_AtmP(1)%vp (self%isc:self%iec,self%jsc:self%jec,:) = pert%v (self%isc:self%iec,self%jsc:self%jec,:)
857  self%FV_AtmP(1)%ptp (self%isc:self%iec,self%jsc:self%jec,:) = pert%T (self%isc:self%iec,self%jsc:self%jec,:)
858  self%FV_AtmP(1)%delpp(self%isc:self%iec,self%jsc:self%jec,:) = pert%delp(self%isc:self%iec,self%jsc:self%jec,:)
859 
860  self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,1) = pert%qv(self%isc:self%iec,self%jsc:self%jec,:)
861  self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,2) = pert%ql(self%isc:self%iec,self%jsc:self%jec,:)
862  self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,3) = pert%qi(self%isc:self%iec,self%jsc:self%jec,:)
863  self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,4) = pert%o3(self%isc:self%iec,self%jsc:self%jec,:)
864 
865  if (conf%do_phy_mst .ne. 0) then
866  self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,5) = pert%cfcn(self%isc:self%iec,self%jsc:self%jec,:)
867  endif
868 
869  if (.not. self%FV_Atm(1)%flagstruct%hydrostatic) then
870  self%FV_AtmP(1)%delzp(self%isc:self%iec,self%jsc:self%jec,:) = pert%delz(self%isc:self%iec,self%jsc:self%jec,:)
871  self%FV_AtmP(1)%wp (self%isc:self%iec,self%jsc:self%jec,:) = pert%w (self%isc:self%iec,self%jsc:self%jec,:)
872  endif
873 
874  self%FV_AtmP(1)%uap(self%isc:self%iec,self%jsc:self%jec,:) = 0.0!pert%ua(self%isc:self%iec,self%jsc:self%jec,:)
875  self%FV_AtmP(1)%vap(self%isc:self%iec,self%jsc:self%jec,:) = 0.0!pert%va(self%isc:self%iec,self%jsc:self%jec,:)
876 
877 endsubroutine pert_to_fv3
878 
879 ! ------------------------------------------------------------------------------
880 
881 subroutine fv3_to_pert(self,conf,pert)
883  implicit none
884 
885  class(fv3jedi_lm_dynamics_type), intent(inout) :: self
886  type(fv3jedi_lm_conf), intent(in) :: conf
887  type(fv3jedi_lm_pert), intent(inout) :: pert
888 
889  pert%u (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%up (self%isc:self%iec,self%jsc:self%jec,:)
890  pert%v (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%vp (self%isc:self%iec,self%jsc:self%jec,:)
891  pert%T (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%ptp (self%isc:self%iec,self%jsc:self%jec,:)
892  pert%delp(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%delpp(self%isc:self%iec,self%jsc:self%jec,:)
893 
894  pert%qv(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,1)
895  pert%ql(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,2)
896  pert%qi(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,3)
897  pert%o3(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,4)
898 
899  if (conf%do_phy_mst .ne. 0) then
900  pert%cfcn(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%qp(self%isc:self%iec,self%jsc:self%jec,:,5)
901  endif
902 
903  if (.not. self%FV_Atm(1)%flagstruct%hydrostatic) then
904  pert%delz(self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%delzp(self%isc:self%iec,self%jsc:self%jec,:)
905  pert%w (self%isc:self%iec,self%jsc:self%jec,:) = self%FV_AtmP(1)%wp (self%isc:self%iec,self%jsc:self%jec,:)
906  endif
907 
908  pert%ua(self%isc:self%iec,self%jsc:self%jec,:) = 0.0!self%FV_AtmP(1)%uap(self%isc:self%iec,self%jsc:self%jec,:)
909  pert%va(self%isc:self%iec,self%jsc:self%jec,:) = 0.0!self%FV_AtmP(1)%vap(self%isc:self%iec,self%jsc:self%jec,:)
910 
911  self%FV_AtmP(1)%up = 0.0
912  self%FV_AtmP(1)%vp = 0.0
913  self%FV_AtmP(1)%ptp = 0.0
914  self%FV_AtmP(1)%delpp = 0.0
915  self%FV_AtmP(1)%qp = 0.0
916  self%FV_AtmP(1)%wp = 0.0
917  self%FV_AtmP(1)%delzp = 0.0
918  self%FV_AtmP(1)%uap = 0.0
919  self%FV_AtmP(1)%vap = 0.0
920 
921 endsubroutine fv3_to_pert
922 
923 ! ------------------------------------------------------------------------------
924 
925 subroutine zero_pert_vars(FV_AtmP)
927 implicit none
928 type(fv_atmos_pert_type), intent(inout) :: FV_AtmP
929 
930 !Prognostic
931 fv_atmp%up = 0.0
932 fv_atmp%vp = 0.0
933 fv_atmp%ptp = 0.0
934 fv_atmp%delpp = 0.0
935 fv_atmp%qp = 0.0
936 fv_atmp%wp = 0.0
937 fv_atmp%delzP = 0.0
938 
939 !Outputs
940 fv_atmp%ze0p = 0.0
941 fv_atmp%q_conp = 0.0
942 fv_atmp%psp = 0.0
943 fv_atmp%pep = 0.0
944 fv_atmp%pkp = 0.0
945 fv_atmp%pelnp = 0.0
946 fv_atmp%pkzp = 0.0
947 fv_atmp%omgap = 0.0
948 fv_atmp%uap = 0.0
949 fv_atmp%vap = 0.0
950 fv_atmp%ucp = 0.0
951 fv_atmp%vcp = 0.0
952 fv_atmp%mfxp = 0.0
953 fv_atmp%mfyp = 0.0
954 fv_atmp%cxp = 0.0
955 fv_atmp%cyp = 0.0
956 
957 end subroutine zero_pert_vars
958 
959 end module fv3jedi_lm_dynamics_mod
Definition: fms.F90:20
subroutine init_nl(self, conf, pert, traj)
real(kind=kind_real), parameter, public omega
subroutine deallocate_fv_atmos_pert_type(AtmP)
subroutine compute_fv3_pressures(is, ie, js, je, isd, ied, jsd, jed, npz, kappa, ptop, delp, pe, pk, pkz, peln)
Definition: fv_pressure.F90:24
subroutine step_nl(self, conf, traj)
type(cp_iter_controls_type), target, public cp_iter_controls
Definition: conf.py:1
subroutine step_tl(self, conf, traj, pert)
subroutine pert_to_fv3(self, conf, pert)
subroutine, public cp_mod_ini(cp_mod_index)
integer, dimension(:), allocatable, public pelist_all
subroutine init_tl(self, conf, pert, traj)
Definition: mpp.F90:39
subroutine, public cp_mod_mid
subroutine fv3_to_traj(self, conf, traj)
subroutine, public cp_mod_end
subroutine, public fv_dynamics_bwd(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill, reproduce_sum, kappa, cp_air, zvir, ptop, ks, ncnst, n_split, q_split, u, u_ad, v, v_ad, w, w_ad, delz, delz_ad, hydrostatic, pt, pt_ad, delp, delp_ad, q, q_ad, ps, ps_ad, pe, pe_ad, pk, pk_ad, peln, peln_ad, pkz, pkz_ad, phis, q_con, omga, omga_ad, ua, ua_ad, va, va_ad, uc, uc_ad, vc, vc_ad, ak, bk, mfx, mfx_ad, mfy, mfy_ad, cx, cx_ad, cy, cy_ad, ze0, hybrid_z, gridstruct, flagstruct, flagstructp, neststruct, idiag, bd, parent_grid, domain, time_total)
subroutine fv3_to_pert(self, conf, pert)
subroutine, public delete(self)
Top level for fv3jedi linearized dynamical core.
subroutine, public fv_init(Atm, dt_atmos, grids_on_this_pe, p_split)
type(cp_iter_type), dimension(:), allocatable, target, public cp_iter
subroutine, public finalize_cp_iter
real(kind=kind_real), parameter, public zvir
subroutine, public fv_init_pert(Atm, AtmP)
subroutine, public fv_dynamics(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill, reproduce_sum, kappa, cp_air, zvir, ptop, ks, ncnst, n_split, q_split, u, v, w, delz, hydrostatic, pt, delp, q, ps, pe, pk, peln, pkz, phis, q_con, omga, ua, va, uc, vc, ak, bk, mfx, mfy, cx, cy, ze0, hybrid_z, gridstruct, flagstruct, neststruct, idiag, bd, parent_grid, domain, time_total)
real(kind=kind_real), parameter, public cp
subroutine init_ad(self, conf, pert, traj)
Variable transforms on pressure variables for fv3 Daniel Holdaway, NASA/JCSDA.
Definition: fv_pressure.F90:9
subroutine compute_fv3_pressures_bwd(is, ie, js, je, isd, ied, jsd, jed, npz, kappa, ptop, delp, delp_ad, pe, pe_ad, pk, pk_ad, pkz, pkz_ad, peln, peln_ad)
subroutine step_ad(self, conf, traj, pert)
subroutine deallocate_fv_atmos_type(Atm)
subroutine, public initialize_cp_iter
subroutine compute_fv3_pressures_tlm(is, ie, js, je, isd, ied, jsd, jed, npz, kappa, ptop, delp, delp_tl, pe, pe_tl, pk, pk_tl, pkz, pkz_tl, peln, peln_tl)
Definition: fv_pressure.F90:74
subroutine traj_to_fv3(self, conf, traj)
subroutine, public create(self, geom, vars)
subroutine, public fv_dynamics_fwd(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill, reproduce_sum, kappa, cp_air, zvir, ptop, ks, ncnst, n_split, q_split, u, v, w, delz, hydrostatic, pt, delp, q, ps, pe, pk, peln, pkz, phis, q_con, omga, ua, va, uc, vc, ak, bk, mfx, mfy, cx, cy, ze0, hybrid_z, gridstruct, flagstruct, flagstructp, neststruct, idiag, bd, parent_grid, domain, time_total)
real(kind=kind_real), parameter, public kappa
Constants for the FV3 model.
real(fp), parameter, public pi
subroutine, public fv_dynamics_tlm(npx, npy, npz, nq_tot, ng, bdt, consv_te, fill, reproduce_sum, kappa, cp_air, zvir, ptop, ks, ncnst, n_split, q_split, u, u_tl, v, v_tl, w, w_tl, delz, delz_tl, hydrostatic, pt, pt_tl, delp, delp_tl, q, q_tl, ps, ps_tl, pe, pe_tl, pk, pk_tl, peln, peln_tl, pkz, pkz_tl, phis, q_con, omga, omga_tl, ua, ua_tl, va, va_tl, uc, uc_tl, vc, vc_tl, ak, bk, mfx, mfx_tl, mfy, mfy_tl, cx, cx_tl, cy, cy_tl, ze0, hybrid_z, gridstruct, flagstruct, flagstructp, neststruct, idiag, bd, parent_grid, domain, time_total)