CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
unified_ugwp.F90
1
3
4!! 1) The "V0 CIRES UGWP" scheme (cires_ugwp.F90) as implemented in the FV3GFSv16 atmosphere model, which includes:
5!! a) the "traditional" EMC orograhic gravity wave drag and flow blocking scheme of gwdps.f
6!! b) the v0 cires ugwp non-stationary GWD scheme
7!! 2) The GSL orographic drag suite (drag_suite.F90), as implmeneted in the RAP/HRRR, which includes:
8!! a) mesoscale gravity wave drag and low-level flow blocking -- active at horizontal scales
9!! down to ~5km (Kim and Arakawa, 1995 \cite kim_and_arakawa_1995; Kim and Doyle, 2005 \cite kim_and_doyle_2005)
10!! b) small-scale gravity wave drag scheme -- active typically in stable PBL at horizontal grid resolutions down to ~1km
11!! (Steeneveld et al, 2008 \cite steeneveld_et_al_2008; Tsiringakis et al, 2017 \cite tsiringakis_et_al_2017)
12!! c) turbulent orographic form drag -- active at horizontal grid ersolutions down to ~1km
13!! (Beljaars et al, 2004 \cite beljaars_et_al_2004)
14!! Gravity waves (GWs): Mesoscale GWs transport momentum, energy (heat) , and create eddy mixing in the whole atmosphere domain; Breaking and dissipating GWs deposit: (a) momentum; (b) heat (energy); and create (c) turbulent mixing of momentum, heat, and tracers
15!! To properly incorporate GW effects (a-c) unresolved by DYCOREs we need GW physics
16!! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers.
17!! Unified Formalism:
18!! 1. GW Sources: Stochastic and physics based mechanisms for GW-excitations in the lower atmosphere, calibrated by the high-res analyses/forecasts, and observations (3 types of GW sources: orography, convection, fronts/jets).
19!! 2. GW Propagation: Unified solver for "propagation, dissipation and breaking" excited from all type of GW sources.
20!! 3. GW Effects: Unified representation of GW impacts on the "resolved" flow for all sources (energy-balanced schemes for momentum, heat and mixing).
21!! https://www.weather.gov/media/sti/nggps/Presentations%202017/02%20NGGPS_VYUDIN_2017_.pdf
22!!
23!! The unified_ugwp scheme is activated by gwd_opt = 2 in the namelist.
24!! The choice of schemes is activated at runtime by the following namelist options (boolean):
25!! do_ugwp_v0 -- activates V0 CIRES UGWP scheme - both orographic and non-stationary GWD
26!! do_ugwp_v0_orog_only -- activates V0 CIRES UGWP scheme - orographic GWD only
27!! do_ugwp_v0_nst_only -- activates V0 CIRES UGWP scheme - non-stationary GWD only
28!! do_gsl_drag_ls_bl -- activates RAP/HRRR (GSL) mesoscale GWD and blocking
29!! do_gsl_drag_ss -- activates RAP/HRRR (GSL) small-scale GWD
30!! do_gsl_drag_tofd -- activates RAP/HRRR (GSL) turbulent orographic drag
31!! Note that only one "mesoscale" scheme can be activated at a time.
32!!
33
35
36 use machine, only: kind_phys
37
38! use cires_ugwp_module, only: knob_ugwp_version, cires_ugwp_mod_init, cires_ugwp_mod_finalize
39 use cires_ugwpv0_module, only: knob_ugwp_version, cires_ugwpv0_mod_init, cires_ugwpv0_mod_finalize
40 use gwdps, only: gwdps_run
43 use drag_suite, only: drag_suite_run, drag_suite_psl
44
45 implicit none
46
47 private
48
50
51 logical :: is_initialized = .false.
52
53contains
54
55! ------------------------------------------------------------------------
56! CCPP entry points for CIRES Unified Gravity Wave Physics (UGWP) scheme v0
57! ------------------------------------------------------------------------
65 subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, &
66 fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, &
67 con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, &
68 do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, &
69 do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, gwd_opt, &
70 errmsg, errflg)
71
72!---- initialization of unified_ugwp
73 implicit none
74
75 integer, intent (in) :: me
76 integer, intent (in) :: master
77 integer, intent (in) :: nlunit
78 character(len=*), intent (in) :: input_nml_file(:)
79 integer, intent (in) :: logunit
80 integer, intent (in) :: jdat(:)
81 integer, intent (in) :: lonr
82 integer, intent (in) :: levs
83 integer, intent (in) :: latr
84 real(kind=kind_phys), intent (in) :: ak(:), bk(:)
85 real(kind=kind_phys), intent (in) :: dtp
86 real(kind=kind_phys), intent (in) :: cdmbgwd(:), cgwf(:) ! "scaling" controls for "old" GFS-GW schemes
87 real(kind=kind_phys), intent (in) :: pa_rf_in, tau_rf_in
88 real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth
89 logical, intent (in) :: do_ugwp
90 logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, &
91 do_ugwp_v0_nst_only, &
92 do_gsl_drag_ls_bl, do_gsl_drag_ss, &
93 do_gsl_drag_tofd
94
95 character(len=*), intent (in) :: fn_nml2
96 !character(len=*), parameter :: fn_nml='input.nml'
97
98 integer :: ios
99 logical :: exists
100 real :: dxsg
101 integer :: k
102
103 integer, intent(in) :: gwd_opt
104 character(len=*), intent(out) :: errmsg
105 integer, intent(out) :: errflg
106
107 ! Initialize CCPP error handling variables
108 errmsg = ''
109 errflg = 0
110
111 ! Consistency checks
112 if (gwd_opt/=2 .and. gwd_opt/=22) then
113 write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave &
114 & drag is different from unified_ugwp scheme"
115 errflg = 1
116 return
117 end if
118
119 ! Test to make sure that at most only one mesoscale/blocking
120 ! orographic drag scheme is chosen
121 if ( (do_ugwp_v0.and.(do_ugwp_v0_orog_only.or.do_gsl_drag_ls_bl)) .or. &
122 (do_ugwp_v0_orog_only.and.do_gsl_drag_ls_bl) ) then
123
124 write(errmsg,'(*(a))') "Logic error: Only one mesoscale&
125 &/blocking scheme (do_ugwp_v0,do_ugwp_v0_orog_only,&
126 &do_gsl_drag_ls_bl can be chosen"
127 errflg = 1
128 return
129
130 end if
131
132
133 if (is_initialized) return
134
135
136 if ( do_ugwp_v0 .or. do_ugwp_v0_nst_only ) then
137 ! if (do_ugwp .or. cdmbgwd(3) > 0.0) then (deactivate effect of do_ugwp)
138 if (cdmbgwd(3) > 0.0) then
139 call cires_ugwpv0_mod_init(me, master, nlunit, input_nml_file, logunit, &
140 fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, &
141 cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in)
142 else
143 write(errmsg,'(*(a))') "Logic error: cires_ugwp_mod_init called but &
144 &do_ugwp_v0 or do_ugwp_v0_nst_only is true and cdmbgwd(3) <= 0"
145 errflg = 1
146 return
147 end if
148 end if
149
150
151 is_initialized = .true.
152
153 end subroutine unified_ugwp_init
154
155
156! -----------------------------------------------------------------------
157! finalize of unified_ugwp (_finalize)
158! -----------------------------------------------------------------------
159
161
165 subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v0_nst_only, &
166 errmsg, errflg)
167
168 implicit none
169!
170 logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_nst_only
171 character(len=*), intent(out) :: errmsg
172 integer, intent(out) :: errflg
173
174! Initialize CCPP error handling variables
175 errmsg = ''
176 errflg = 0
177
178 if (.not.is_initialized) return
179
180 if ( do_ugwp_v0 .or. do_ugwp_v0_nst_only ) call cires_ugwpv0_mod_finalize()
181
182 is_initialized = .false.
183
184 end subroutine unified_ugwp_finalize
185
186
187! -----------------------------------------------------------------------
188! originally from ugwp_driver_v0.f
189! driver of cires_ugwp (_driver)
190! -----------------------------------------------------------------------
191! driver is called after pbl & before chem-parameterizations
192! -----------------------------------------------------------------------
193! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re
194! -----------------------------------------------------------------------
246! \section det_unified_ugwp GFS Unified GWP Scheme Detailed Algorithm
247 subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt, &
248 lonr, oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, &
249 varss,oc1ss,oa4ss,ol4ss,dx,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl,dusfc_ss, &
250 dvsfc_ss,dusfc_fd,dvsfc_fd,dtaux2d_ms,dtauy2d_ms,dtaux2d_bl,dtauy2d_bl, &
251 dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dudt_ngw,dvdt_ngw,dtdt_ngw, &
252 br1,hpbl,vtype,slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, &
253 cdmbgwd, alpha_fd, jdat, xlat, xlat_d, sinlat, coslat, area, &
254 ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, &
255 del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, &
256 tau_tofd, tau_mtb, tau_ogw, tau_ngw, &
257 dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, &
258 dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, &
259 con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, &
260 ldiag3d, dtend, dtidx, index_of_temperature, index_of_x_wind, &
261 index_of_y_wind, index_of_process_orographic_gwd, &
262 index_of_process_nonorographic_gwd, &
263 lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, &
264 do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, &
265 do_gwd_opt_psl, psl_gwd_dx_factor, &
266 gwd_opt, spp_wts_gwd, spp_gwd, errmsg, errflg)
267
268 implicit none
269
270 ! interface variables
271 integer, intent(in) :: me, master, im, levs, ntrac, kdt, lonr, nmtvr
272 integer, intent(in) :: gwd_opt
273 integer, intent(in), dimension(:) :: kpbl
274 integer, intent(in), dimension(:) :: vtype
275 real(kind=kind_phys), intent(in), dimension(:) :: ak, bk
276 real(kind=kind_phys), intent(in), dimension(:) :: oro, oro_uf, hprime, oc, theta, sigma, gamma
277 real(kind=kind_phys), intent(in), dimension(:), optional :: varss,oc1ss
278 real(kind=kind_phys), intent(in), dimension(:) :: dx
279
280!vay-nov 2020
281 real(kind=kind_phys), intent(in), dimension(:,:), optional :: oa4ss,ol4ss
282
283 logical, intent(in) :: flag_for_gwd_generic_tend
284
285 ! elvmax is intent(in) for CIRES UGWPv1, but intent(inout) for GFS GWDPS
286
287 real(kind=kind_phys), intent(inout), dimension(:) :: elvmax
288 real(kind=kind_phys), intent(in), dimension(:,:) :: clx, oa4
289 real(kind=kind_phys), intent(in), dimension(:) :: xlat, xlat_d, sinlat, coslat, area
290 real(kind=kind_phys), intent(in), dimension(:,:) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil
291 real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii
292 real(kind=kind_phys), intent(in), dimension(:,:) :: q1
293 real(kind=kind_phys), intent(in) :: dtp, fhzero, cdmbgwd(:), alpha_fd
294 integer, intent(in) :: jdat(:)
295 logical, intent(in) :: do_tofd, ldiag_ugwp, ugwp_seq_update
296
297!Output (optional):
298 real(kind=kind_phys), intent(out), optional :: &
299 & dusfc_ms(:),dvsfc_ms(:), &
300 & dusfc_bl(:),dvsfc_bl(:), &
301 & dusfc_ss(:),dvsfc_ss(:), &
302 & dusfc_fd(:),dvsfc_fd(:)
303 real(kind=kind_phys), intent(out), optional :: &
304 & dtaux2d_ms(:,:),dtauy2d_ms(:,:), &
305 & dtaux2d_bl(:,:),dtauy2d_bl(:,:), &
306 & dtaux2d_ss(:,:),dtauy2d_ss(:,:), &
307 & dtaux2d_fd(:,:),dtauy2d_fd(:,:), &
308 & dudt_ngw(:,:),dvdt_ngw(:,:),dtdt_ngw(:,:)
309 real(kind=kind_phys), intent(in) :: hpbl(:), &
310 & br1(:), &
311 & slmsk(:)
312
313 real(kind=kind_phys), intent(out), dimension(:) :: dusfcg, dvsfcg
314 real(kind=kind_phys), intent(out), dimension(:) :: rdxzb
315 real(kind=kind_phys), intent(out), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw
316 real(kind=kind_phys), intent(out), dimension(:,:) :: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis
317 real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms
318
319 real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:)
320 integer, intent(in) :: dtidx(:,:)
321 integer, intent(in) :: index_of_temperature, index_of_x_wind, &
322 index_of_y_wind, index_of_process_nonorographic_gwd, &
323 index_of_process_orographic_gwd
324 logical, intent(in) :: ldiag3d, lssav
325
326 ! These arrays only allocated if ldiag_ugwp = .true.
327 real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms
328
329 real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt
330
331 real(kind=kind_phys), intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, &
332 con_rv, con_rerth, con_fvirt
333
334 real(kind=kind_phys), intent(in), dimension(:) :: rain
335
336 integer, intent(in) :: ntke
337 real(kind=kind_phys), intent(in), dimension(:,:) :: q_tke, dqdt_tke
338
339 logical, intent(in) :: lprnt
340 integer, intent(in) :: ipr
341
342 ! flags for choosing combination of GW drag schemes to run
343 logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, &
344 do_ugwp_v0_nst_only, &
345 do_gsl_drag_ls_bl, do_gsl_drag_ss, &
346 do_gsl_drag_tofd
347
348 real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:)
349 integer, intent(in) :: spp_gwd
350
351 ! option for psl gwd
352 logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag
353 real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor !
354
355 character(len=*), intent(out) :: errmsg
356 integer, intent(out) :: errflg
357
358 ! local variables
359 integer :: i, k
360 real(kind=kind_phys), dimension(im) :: sgh30
361 real(kind=kind_phys), dimension(im, levs) :: pdvdt, pdudt
362 real(kind=kind_phys), dimension(im, levs) :: pdtdt, pkdis
363
364 ! Variables for optional sequential updating of winds between the
365 ! LSGWD+BLOCKING and SSGWD+TOFD steps. They are placeholders
366 ! for the u,v winds that are updated within the scheme if
367 ! ugwp_seq_update == T, otherwise, they retain the values
368 ! passed to the scheme.
369 real(kind=kind_phys), dimension(im, levs) :: uwnd1, vwnd1
370
371 real(kind=kind_phys), parameter :: tamp_mpa=30.e-3
372
373 integer :: nmtvr_temp, idtend
374
375 real(kind=kind_phys), dimension(:,:), allocatable :: tke
376 real(kind=kind_phys), dimension(:), allocatable :: turb_fac, tem
377 real(kind=kind_phys) :: rfac, tx1
378
379 real(kind=kind_phys) :: inv_g
380 real(kind=kind_phys), dimension(im, levs) :: zmet ! geopotential height at model Layer centers
381 real(kind=kind_phys), dimension(im, levs+1) :: zmeti ! geopotential height at model layer interfaces
382
383 ! Initialize CCPP error handling variables
384 errmsg = ''
385 errflg = 0
386
387
388 ! Initialize intent(out) variables in case they are not set below
389 dusfcg(:) = 0.0
390 dvsfcg(:) = 0.0
391 rdxzb(:) = 0.0
392 tau_ngw(:) = 0.0
393 gw_dudt(:,:) = 0.0
394 gw_dvdt(:,:) = 0.0
395 gw_dtdt(:,:) = 0.0
396 gw_kdis(:,:) = 0.0
397 dudt_mtb(:,:) = 0.0
398 dudt_tms(:,:) = 0.0
399
400 ! 1) ORO stationary GWs
401 ! ------------------
402
403 ! Initialize optional diagnostic variables for ORO drag
404 if ( ldiag_ugwp ) then
405 dusfc_ms(:) = 0.0
406 dvsfc_ms(:) = 0.0
407 dusfc_bl(:) = 0.0
408 dvsfc_bl(:) = 0.0
409 dusfc_ss(:) = 0.0
410 dvsfc_ss(:) = 0.0
411 dusfc_fd(:) = 0.0
412 dvsfc_fd(:) = 0.0
413 dtaux2d_ms(:,:)= 0.0
414 dtauy2d_ms(:,:)= 0.0
415 dtaux2d_bl(:,:)= 0.0
416 dtauy2d_bl(:,:)= 0.0
417 dtaux2d_ss(:,:)= 0.0
418 dtauy2d_ss(:,:)= 0.0
419 dtaux2d_fd(:,:)= 0.0
420 dtauy2d_fd(:,:)= 0.0
421 end if
422
423
424 ! Prepare to run UGWP_v0 mesoscale GWD + blocking scheme
425 ! These tendency initializations pertain to the non-stationary GWD
426 ! scheme as well
427 if ( do_ugwp_v0.or.do_ugwp_v0_orog_only.or.do_ugwp_v0_nst_only ) then
428
429 do k=1,levs
430 do i=1,im
431 pdvdt(i,k) = 0.0
432 pdudt(i,k) = 0.0
433 pdtdt(i,k) = 0.0
434 pkdis(i,k) = 0.0
435 enddo
436 enddo
437
438 end if
439
440 ! Initialize winds and temperature for sequential updating
441 ! NOTE: These will only be updated if ugwp_seq_update == .true.
442 uwnd1(:,:) = ugrs(:,:)
443 vwnd1(:,:) = vgrs(:,:)
444
445 if ( do_ugwp_v0.or.do_ugwp_v0_orog_only ) then
446
447 if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then
448
449 ! Override nmtvr with nmtvr_temp = 14 for passing into gwdps_run if
450 ! necessary
451 if ( nmtvr == 24 ) then ! gwd_opt = 2, 22, 3, or 33
452 nmtvr_temp = 14
453 else
454 nmtvr_temp = nmtvr
455 end if
456
457 call gwdps_run(im, levs, pdvdt, pdudt, pdtdt, &
458 ugrs, vgrs, tgrs, q1, &
459 kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, &
460 hprime, oc, oa4, clx, theta, sigma, gamma, &
461 elvmax, dusfcg, dvsfcg, dtaux2d_ms, dtauy2d_ms, &
462 dtaux2d_bl, dtauy2d_bl, dusfc_ms, dvsfc_ms, &
463 dusfc_bl, dvsfc_bl, &
464 con_g, con_cp, con_rd, con_rv, lonr, &
465 nmtvr_temp, cdmbgwd, me, lprnt, ipr, rdxzb, &
466 ldiag_ugwp, errmsg, errflg)
467 if (errflg/=0) return
468
469 ! Update winds if sequential updating is selected
470 ! and SSGWD and TOFD will be calculated
471 if ( ugwp_seq_update .and. (do_gsl_drag_ss.or.do_gsl_drag_tofd) ) then
472 uwnd1(:,:) = uwnd1(:,:) + pdudt(:,:)*dtp
473 vwnd1(:,:) = vwnd1(:,:) + pdvdt(:,:)*dtp
474 endif
475
476 endif
477
478 tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0
479 if (ldiag_ugwp) then
480 du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0
481 end if
482
483
484 if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then
485 idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd)
486 if(idtend>=1) then
487 dtend(:,:,idtend) = dtend(:,:,idtend) + pdudt*dtp
488 endif
489
490 idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd)
491 if(idtend>=1) then
492 dtend(:,:,idtend) = dtend(:,:,idtend) + pdvdt*dtp
493 endif
494
495 idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd)
496 if(idtend>=1) then
497 dtend(:,:,idtend) = dtend(:,:,idtend) + pdtdt*dtp
498 endif
499 endif
500
501 end if
502
503
504
505 ! Run the appropriate mesoscale (mesoscale GWD + blocking) scheme
506 ! Note: In case of GSL drag_suite, this includes ss and tofd
507
508 if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then
509!
510 if (do_gwd_opt_psl) then
511 call drag_suite_psl(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, &
512 tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, &
513 kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, &
514 ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ms, &
515 dtauy2d_ms,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, &
516 dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfcg, &
517 dvsfcg,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl, &
518 dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, &
519 slmsk,br1,hpbl,vtype,con_g,con_cp,con_rd,con_rv, &
520 con_fvirt,con_pi,lonr, &
521 cdmbgwd,alpha_fd,me,master, &
522 lprnt,ipr,rdxzb,dx,gwd_opt, &
523 do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, &
524 psl_gwd_dx_factor, &
525 dtend, dtidx, index_of_process_orographic_gwd, &
526 index_of_temperature, index_of_x_wind, &
527 index_of_y_wind, ldiag3d, ldiag_ugwp, &
528 ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
529 else
530 call drag_suite_run(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, &
531 tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, &
532 kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, &
533 ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ms, &
534 dtauy2d_ms,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, &
535 dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfcg, &
536 dvsfcg,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl, &
537 dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, &
538 slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, &
539 con_fvirt,con_pi,lonr, &
540 cdmbgwd,alpha_fd,me,master, &
541 lprnt,ipr,rdxzb,dx,gwd_opt, &
542 do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, &
543 dtend, dtidx, index_of_process_orographic_gwd, &
544 index_of_temperature, index_of_x_wind, &
545 index_of_y_wind, ldiag3d, ldiag_ugwp, &
546 ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
547 endif
548!
549! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ms,dvsfc_ms
550!
551 tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0.
552 dudt_mtb = 0. ; dudt_tms = 0.
553
554 end if
555
556
557
558 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
559 ! Begin non-stationary GW schemes
560 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
561
562 !
563 ! ugwp_v0 non-stationary GW drag
564 !
565 if (do_ugwp_v0.or.do_ugwp_v0_nst_only) then
566
567 if (cdmbgwd(3) > 0.0) then
568
569 ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing
570 call slat_geos5_tamp_v0(im, tamp_mpa, xlat_d, tau_ngw)
571
572 if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then
573 if (cdmbgwd(4) > 0.0) then
574 allocate(turb_fac(im))
575 do i=1,im
576 turb_fac(i) = 0.0
577 enddo
578 if (ntke > 0) then
579 allocate(tke(im,levs))
580 allocate(tem(im))
581 tke(:,:) = q_tke(:,:) + dqdt_tke(:,:) * dtp
582 tem(:) = 0.0
583 do k=1,(levs+levs)/3
584 do i=1,im
585 turb_fac(i) = turb_fac(i) + del(i,k) * tke(i,k)
586 tem(i) = tem(i) + del(i,k)
587 enddo
588 enddo
589 do i=1,im
590 turb_fac(i) = turb_fac(i) / tem(i)
591 enddo
592 deallocate(tke)
593 deallocate(tem)
594 endif
595 rfac = 86400000 / dtp
596 do i=1,im
597 tx1 = cdmbgwd(4)*min(10.0, max(turb_fac(i),rain(i)*rfac))
598 tau_ngw(i) = tau_ngw(i) * max(0.1, min(5.0, tx1))
599 enddo
600 deallocate(turb_fac)
601 endif
602 do i=1,im
603 tau_ngw(i) = tau_ngw(i) * cdmbgwd(3)
604 enddo
605 endif
606
607 call fv3_ugwp_solv2_v0(im, levs, dtp, tgrs, ugrs, vgrs, q1, &
608 prsl, prsi, phil, xlat_d, sinlat, coslat, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, &
609 tau_ngw, me, master, kdt)
610
611 ! Save u, v, and t non-orogarphic tendencies for diagnostic output
612 dudt_ngw = gw_dudt
613 dvdt_ngw = gw_dvdt
614 dtdt_ngw = gw_dtdt
615
616 do k=1,levs
617 do i=1,im
618 gw_dtdt(i,k) = gw_dtdt(i,k)+ pdtdt(i,k)
619 gw_dudt(i,k) = gw_dudt(i,k)+ pdudt(i,k)
620 gw_dvdt(i,k) = gw_dvdt(i,k)+ pdvdt(i,k)
621 gw_kdis(i,k) = gw_kdis(i,k)+ pkdis(i,k)
622 ! accumulation of tendencies for CCPP to replicate EMC-physics updates (!! removed in latest code commit to VLAB)
623 !dudt(i,k) = dudt(i,k) +gw_dudt(i,k)
624 !dvdt(i,k) = dvdt(i,k) +gw_dvdt(i,k)
625 !dtdt(i,k) = dtdt(i,k) +gw_dtdt(i,k)
626 enddo
627 enddo
628
629 else ! .not.(cdmbgwd(3) > 0.0)
630
631 do k=1,levs
632 do i=1,im
633 gw_dtdt(i,k) = pdtdt(i,k)
634 gw_dudt(i,k) = pdudt(i,k)
635 gw_dvdt(i,k) = pdvdt(i,k)
636 gw_kdis(i,k) = pkdis(i,k)
637 enddo
638 enddo
639
640 endif ! cdmbgwd(3) > 0.0
641
642 if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then
643 idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd)
644 if(idtend>=1) then
645 dtend(:,:,idtend) = dtend(:,:,idtend) + pdudt*dtp
646 endif
647
648 idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd)
649 if(idtend>=1) then
650 dtend(:,:,idtend) = dtend(:,:,idtend) + pdvdt*dtp
651 endif
652
653 idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd)
654 if(idtend>=1) then
655 dtend(:,:,idtend) = dtend(:,:,idtend) + pdtdt*dtp
656 endif
657 endif
658
659 end if ! do_ugwp_v0.or.do_ugwp_v0_nst_only
660
661
662 end subroutine unified_ugwp_run
664end module unified_ugwp
subroutine gwdps_run(im, km, a, b, c, u1, v1, t1, q1, kpbl, prsi, del, prsl, prslk, phii, phil, deltim, kdt, hprime, oc, oa4, clx4, theta, sigma, gamma, elvmax, dusfc, dvsfc, dtaux2d_ms, dtauy2d_ms, dtaux2d_bl, dtauy2d_bl, dusfc_ms, dvsfc_ms, dusfc_bl, dvsfc_bl, g, cp, rd, rv, imx, nmtvr, cdmbgwd, me, lprnt, ipr, rdxzb, ldiag_ugwp, errmsg, errflg)
Definition gwdps.f:203
subroutine, public unified_ugwp_init(me, master, nlunit, input_nml_file, logunit, fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, gwd_opt, errmsg, errflg)
subroutine, public unified_ugwp_run(me, master, im, levs, ak, bk, ntrac, dtp, fhzero, kdt, lonr, oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, varss, oc1ss, oa4ss, ol4ss, dx, dusfc_ms, dvsfc_ms, dusfc_bl, dvsfc_bl, dusfc_ss, dvsfc_ss, dusfc_fd, dvsfc_fd, dtaux2d_ms, dtauy2d_ms, dtaux2d_bl, dtauy2d_bl, dtaux2d_ss, dtauy2d_ss, dtaux2d_fd, dtauy2d_fd, dudt_ngw, dvdt_ngw, dtdt_ngw, br1, hpbl, vtype, slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, cdmbgwd, alpha_fd, jdat, xlat, xlat_d, sinlat, coslat, area, ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, tau_tofd, tau_mtb, tau_ogw, tau_ngw, dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, ldiag3d, dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_gwd_opt_psl, psl_gwd_dx_factor, gwd_opt, spp_wts_gwd, spp_gwd, errmsg, errflg)
This subroutine executes the CIRES UGWP Version 0.
subroutine, public unified_ugwp_finalize(do_ugwp_v0, do_ugwp_v0_nst_only, errmsg, errflg)
The subroutine finalizes the GFS UGWP.
This module contains the CCPP-compliant orographic gravity wave dray scheme. This version of gwdps is...
Definition gwdps.f:7