CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
ugwpv1_gsldrag.F90
1
36
38
39 use machine, only: kind_phys
40
41 use cires_ugwpv1_triggers, only: slat_geos5_2020, slat_geos5_tamp_v1
42 use cires_ugwpv1_module, only: cires_ugwpv1_init, ngwflux_update, calendar_ugwp
43 use cires_ugwpv1_module, only: knob_ugwp_version, cires_ugwp_dealloc, tamp_mpa
44 use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2
45 use cires_ugwpv1_oro, only: orogw_v1
46
47 use drag_suite, only: drag_suite_run, drag_suite_psl
48
49 implicit none
50
51 private
52
53 public ugwpv1_gsldrag_init, ugwpv1_gsldrag_run, ugwpv1_gsldrag_finalize
54
55 logical :: is_initialized = .false.
56
57contains
58
59! ------------------------------------------------------------------------
60! CCPP entry points for CIRES Unified Gravity Wave Physics (UGWP) scheme v0
61! ------------------------------------------------------------------------
65 subroutine ugwpv1_gsldrag_init ( &
66 me, master, nlunit, input_nml_file, logunit, &
67 fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, &
68 con_pi, con_rerth, con_p0, &
69 con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt, &
70 do_ugwp,do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, &
71 do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, &
72 do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, errmsg, errflg)
73
74 use ugwp_common
75
76!---- initialization of unified_ugwp
77 implicit none
78
79 integer, intent (in) :: me
80 integer, intent (in) :: master
81 integer, intent (in) :: nlunit
82 character(len=*), intent (in) :: input_nml_file(:)
83 integer, intent (in) :: logunit
84 integer, intent (in) :: jdat(:)
85 integer, intent (in) :: lonr
86 integer, intent (in) :: levs
87 integer, intent (in) :: latr
88 real(kind=kind_phys), intent (in) :: ak(:), bk(:)
89 real(kind=kind_phys), intent (in) :: dtp
90
91 real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth
92 real(kind=kind_phys), intent (in) :: con_g, con_cp, con_rd, con_rv, con_omega, con_fvirt
93 logical, intent (in) :: do_ugwp
94
95 logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, &
96 do_gsl_drag_ls_bl, do_gsl_drag_ss, &
97 do_gsl_drag_tofd, do_ugwp_v1, &
98 do_ugwp_v1_orog_only,do_ugwp_v1_w_gsldrag
99
100 character(len=*), intent (in) :: fn_nml2
101 !character(len=*), parameter :: fn_nml='input.nml'
102
103 integer :: ios
104 logical :: exists
105 real :: dxsg
106 integer :: k
107
108 character(len=*), intent(out) :: errmsg
109 integer, intent(out) :: errflg
110
111 ! Initialize CCPP error handling variables
112 errmsg = ''
113 errflg = 0
114!============================================================================
115!
116! gwd_opt => "1 and 2, 3, 22, 33' see previous GSL-commits
117! related to GSL-oro drag suite
118! for use of the new-GSL/old-GFS/EMC inputs for sub-grid orography
119! see details inside /ufs-weather-model/FV3/io/FV3GFS_io.F90
120! FV3GFS_io.F90: if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. &
121! FV3GFS_io.F90: Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then
122! FV3GFS_io.F90: if ( (Model%gwd_opt==3 .or. Model%gwd_opt==33) .or. &
123! FV3GFS_io.F90: ( (Model%gwd_opt==2 .or. Model%gwd_opt==22) .and. &
124!
125! gwd_opt=1 -current 14-element GFS-EMC subgrid-oro input
126! gwd_opt=2 and 3 24-element -current 14-element GFS-EMC subgrid-oro input
127! GSL uses the gwd_opt flag to control "extra" diagnostics (22 and 33)
128! CCPP may use gwd_opt to determine 14 or 24 variables for the input
129! but at present you work with "nmtvr"
130! GFS_GWD_generic.F90: integer, intent(in) :: im, levs, nmtvr
131!GFS_GWD_generic.F90: real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr)
132!GFS_GWD_generic.F90: if (nmtvr == 14) then ! gwd_opt=1 current operational - as of 2014
133!GFS_GWD_generic.F90: elseif (nmtvr == 10) then ????
134!GFS_GWD_generic.F90: elseif (nmtvr == 6) then ????
135!GFS_GWD_generic.F90: elseif (nmtvr == 24) then ! GSD_drag_suite and unified_ugwp gwd_opt=2,3
136!
137! 1) gsldrag: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1
138! 2) CIRES-v1: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd, ldiag_ugwp
139!==============================================================================
140 ! Test to make sure that at most only one large-scale/blocking
141 ! orographic drag scheme is chosen
142 if ( (do_ugwp_v0.and.(do_ugwp_v0_orog_only.or.do_gsl_drag_ls_bl.or. &
143 do_ugwp_v1.or.do_ugwp_v1_orog_only)) .or. &
144 (do_ugwp_v0_orog_only.and.(do_gsl_drag_ls_bl.or.do_ugwp_v1.or. &
145 do_ugwp_v1_orog_only)) .or. &
146 (do_gsl_drag_ls_bl.and.do_ugwp_v1_orog_only) ) then
147
148 write(errmsg,'(*(a))') "Logic error: Only one large-scale&
149 &/blocking scheme (do_ugwp_v0,do_ugwp_v0_orog_only,&
150 &do_gsl_drag_ls_bl,do_ugwp_v1 or &
151 &do_ugwp_v1_orog_only) can be chosen"
152 errflg = 1
153 return
154
155 end if
156!
157 if ( do_ugwp_v0_orog_only .or. do_ugwp_v0) then
158 print *, ' ccpp do_ugwp_v0 active ', do_ugwp_v0
159 print *, ' ccpp do_ugwp_v1_orog_only active ', do_ugwp_v0_orog_only
160 write(errmsg,'(*(a))') " the CIRES <ugwpv1_gsldrag> CCPP-suite does not &
161 support <ugwp_v0> schemes "
162 errflg = 1
163 return
164 endif
165!
166 if (do_ugwp_v1_w_gsldrag .and. do_ugwp_v1_orog_only ) then
167
168 print *, ' do_ugwp_v1_w_gsldrag ', do_ugwp_v1_w_gsldrag
169 print *, ' do_ugwp_v1_orog_only ', do_ugwp_v1_orog_only
170 print *, ' do_gsl_drag_ls_bl ',do_gsl_drag_ls_bl
171 write(errmsg,'(*(a))') " the CIRES <ugwpv1_gsldrag> CCPP-suite intend to &
172 support <ugwp_v1> with <gsldrag> but has Logic error"
173 errflg = 1
174 return
175 endif
176!==========================
177!
178! initialize ugwp_common
179! con_pi, con_rerth, con_p0, con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt
180!
181!==========================
182
183 pi = con_pi
184 arad = con_rerth
185 p0s = con_p0
186 grav = con_g
187 omega1= con_omega
188 cpd = con_cp
189 rd = con_rd
190 rv = con_rv
191 fv = con_fvirt
192
193 grav2 = grav + grav; rgrav = 1.0/grav ; rgrav2 = rgrav*rgrav
194 rdi = 1.0 / rd ; rcpd = 1./cpd; rcpd2 = 0.5/cpd
195 gor = grav/rd
196 gr2 = grav*gor
197 grcp = grav*rcpd
198 gocp = grcp
199 rcpdl = cpd*rgrav
200 grav2cpd = grav*grcp
201
202 pi2 = 2.*pi ; pih = .5*pi
203 rad_to_deg=180.0/pi
204 deg_to_rad=pi/180.0
205
206 bnv2min = (pi2/1800.)*(pi2/1800.)
207 bnv2max = (pi2/30.)*(pi2/30.)
208 dw2min = 1.0
209 velmin = sqrt(dw2min)
210 minvel = 0.5
211
212 omega2 = 2.*omega1
213 omega3 = 3.*omega1
214
215 hpscale = 7000. ; hpskm = hpscale*1.e-3
216 rhp = 1./hpscale
217 rhp2 = 0.5*rhp; rh4 = 0.25*rhp
218 rhp4 = rhp2 * rhp2
219 khp = rhp* rd/cpd
220 mkzmin = pi2/80.0e3
221 mkz2min = mkzmin*mkzmin
222 mkzmax = pi2/500.
223 mkz2max = mkzmax*mkzmax
224 cdmin = 2.e-2/mkzmax
225
226 rcpdt = rcpd/dtp
227
228 if ( do_ugwp_v1 ) then
229 call cires_ugwpv1_init (me, master, nlunit, logunit, jdat, con_pi, &
230 con_rerth, fn_nml2, input_nml_file, lonr, latr, &
231 levs, ak, bk, con_p0, dtp, errmsg, errflg)
232 if (errflg/=0) return
233 end if
234
235 if (me == master) then
236 print *, ' ccpp: ugwpv1_gsldrag_init '
237
238 print *, ' ccpp do_ugwp_v1 flag ', do_ugwp_v1
239 print *, ' ccpp do_gsl_drag_ls_bl flag ', do_gsl_drag_ls_bl
240 print *, ' ccpp do_gsl_drag_ss flag ' , do_gsl_drag_ss
241 print *, ' ccpp do_gsl_drag_tofd flag ', do_gsl_drag_tofd
242
243 print *, ' ccpp: ugwpv1_gsldrag_init '
244 endif
245
246
247
248 is_initialized = .true.
249
250
251 end subroutine ugwpv1_gsldrag_init
252
253
254! -----------------------------------------------------------------------
255! finalize of ugwpv1_gsldrag (_finalize)
256! -----------------------------------------------------------------------
257
259
263 subroutine ugwpv1_gsldrag_finalize(errmsg, errflg)
264
265 implicit none
266!
267 character(len=*), intent(out) :: errmsg
268 integer, intent(out) :: errflg
269
270! Initialize CCPP error handling variables
271 errmsg = ''
272 errflg = 0
273
274 if (.not.is_initialized) return
275
276 call cires_ugwp_dealloc
277
278 is_initialized = .false.
279
280 end subroutine ugwpv1_gsldrag_finalize
281
282
283! -----------------------------------------------------------------------
284! originally from ugwp_driver_v0.f
285! driver of cires_ugwp (_driver)
286! -----------------------------------------------------------------------
287! driver is called after pbl & before chem-parameterizations
288! -----------------------------------------------------------------------
289! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re
290! -----------------------------------------------------------------------
299 subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, &
300 fhzero, kdt, ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, &
301 do_gsl_drag_ss, do_gsl_drag_tofd, &
302 do_gwd_opt_psl, psl_gwd_dx_factor, &
303 do_ugwp_v1, do_ugwp_v1_orog_only, &
304 do_ugwp_v1_w_gsldrag, gwd_opt, do_tofd, ldiag_ugwp, ugwp_seq_update, &
305 cdmbgwd, alpha_fd, jdat, nmtvr, hprime, oc, theta, sigma, gamma, &
306 elvmax, clx, oa4, varss,oc1ss,oa4ss,ol4ss, dx, xlat, xlat_d, sinlat, coslat, &
307 area, rain, br1, hpbl,vtype, kpbl, slmsk, &
308 ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, del, tau_amf, &
309 dudt_ogw, dvdt_ogw, du_ogwcol, dv_ogwcol, &
310 dudt_obl, dvdt_obl, du_oblcol, dv_oblcol, &
311 dudt_oss, dvdt_oss, du_osscol, dv_osscol, &
312 dudt_ofd, dvdt_ofd, du_ofdcol, dv_ofdcol, &
313 dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, dudt_gw, dvdt_gw, dtdt_gw, kdis_gw, &
314 tau_ogw, tau_ngw, tau_oss, &
315 zogw, zlwb, zobl, zngw, dusfcg, dvsfcg, dudt, dvdt, dtdt, rdxzb, &
316 dtend, dtidx, index_of_x_wind, index_of_y_wind, index_of_temperature, &
317 index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, &
318 lprnt, ipr, spp_wts_gwd, spp_gwd, errmsg, errflg)
319
320!
321!########################################################################
322! Attention New Arrays and Names must be ADDED inside
323!
324! a) /FV3/gfsphysics/GFS_layer/GFS_typedefs.meta
325! b) /FV3/gfsphysics/GFS_layer/GFS_typedefs.F90
326! c) /FV3/gfsphysics/GFS_layer/GFS_diagnostics.F90 "diag-cs is not tested"
327!########################################################################
328
329!
330
331 use ugwp_common, only : con_pi => pi, con_g => grav, con_rd => rd, &
332 con_rv => rv, con_cp => cpd, con_fv => fv, &
333 con_rerth => arad, con_omega => omega1, rgrav
334
335 implicit none
336
337! Preference use (im,levs) rather than (:,:) to avoid memory-leaks
338! that found in Nov-Dec 2020
339! order array-description control-logical
340! other in-variables
341! out-variables
342! local-variables
343!
344! unified GSL and CIRES diagnostics inside CCPP and GFS_typedefs.F90/GFS_diagnostics.F90
345!
346!
347! interface variables
348 logical, intent(in) :: ldiag3d, lssav
349 logical, intent(in) :: flag_for_gwd_generic_tend
350 logical, intent(in) :: lprnt
351
352 integer, intent(in) :: ipr
353
354! flags for choosing combination of GW drag schemes to run
355
356 logical, intent (in) :: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd
357 logical, intent (in) :: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd
358 logical, intent (in) :: ldiag_ugwp, ugwp_seq_update
359 logical, intent (in) :: do_ugwp_v1_w_gsldrag ! combination of ORO and NGW schemes
360
361 integer, intent(in) :: me, master, im, levs, ntrac,lonr
362 real(kind=kind_phys), intent(in) :: dtp, fhzero
363 real(kind=kind_phys), intent(in) :: ak(:), bk(:)
364 integer, intent(in) :: kdt, jdat(:)
365! option for psl gwd
366 logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag
367 real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor !
368! SSO parameters and variables
369 integer, intent(in) :: gwd_opt !gwd_opt and nmtvr are "redundant" controls
370 integer, intent(in) :: nmtvr
371 real(kind=kind_phys), intent(in) :: cdmbgwd(:), alpha_fd ! for gsl_drag
372
373 real(kind=kind_phys), intent(in), dimension(:) :: hprime, oc, theta, sigma, gamma
374
375 real(kind=kind_phys), intent(in), dimension(:) :: elvmax
376 real(kind=kind_phys), intent(in), dimension(:,:) :: clx, oa4
377
378 real(kind=kind_phys), intent(in), dimension(:) :: dx
379 real(kind=kind_phys), intent(in), dimension(:), optional :: varss,oc1ss
380 real(kind=kind_phys), intent(in), dimension(:,:), optional :: oa4ss,ol4ss
381
382!=====
383!ccpp-style passing constants, I prefer to take them out from the "call-subr" list
384!=====
385! real(kind=kind_phys), intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, &
386! con_rv, con_rerth, con_fvirt
387! grids
388
389 real(kind=kind_phys), intent(in), dimension(:) :: xlat, xlat_d, sinlat, coslat, area
390
391! State vars + PBL/slmsk +rain
392
393 real(kind=kind_phys), intent(in), dimension(:,:) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil
394 real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii
395 real(kind=kind_phys), intent(in), dimension(:,:) :: q1
396 integer, intent(in), dimension(:) :: kpbl
397 integer, intent(in), dimension(:) :: vtype
398
399 real(kind=kind_phys), intent(in), dimension(:) :: rain
400 real(kind=kind_phys), intent(in), dimension(:) :: br1, hpbl, slmsk
401!
402! moved to GFS_phys_time_vary
403! real(kind=kind_phys), intent(in), dimension(:) :: ddy_j1tau, ddy_j2tau
404! integer, intent(in), dimension(:) :: jindx1_tau, jindx2_tau
405 real(kind=kind_phys), intent(in), dimension(:) :: tau_amf
406
407!Output (optional):
408
409 real(kind=kind_phys), intent(out), dimension(:), optional :: &
410 du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, &
411 du_osscol, dv_osscol, du_ofdcol, dv_ofdcol
412!
413! we may add later but due to launch in the upper layes ~ mPa comparing to ORO Pa*(0.1)
414! du_ngwcol, dv_ngwcol
415
416 real(kind=kind_phys), intent(out), dimension(:) :: dusfcg, dvsfcg
417 real(kind=kind_phys), intent(out), dimension(:) :: tau_ogw, tau_ngw, tau_oss
418
419 real(kind=kind_phys), intent(out) , dimension(:,:), optional :: &
420 dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, &
421 dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd
422
423 real(kind=kind_phys), intent(out) , dimension(:,:), optional :: dudt_ngw, dvdt_ngw, kdis_ngw, dtdt_ngw
424 real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_gw, dvdt_gw, dtdt_gw, kdis_gw
425
426 real(kind=kind_phys), intent(out) , dimension(:) :: zogw, zlwb, zobl, zngw
427!
428!
429 real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt
430
431 real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:)
432 integer, intent(in) :: dtidx(:,:)
433 integer, intent(in) :: &
434 index_of_x_wind, index_of_y_wind, index_of_temperature, &
435 index_of_process_orographic_gwd, index_of_process_nonorographic_gwd
436
437 real(kind=kind_phys), intent(out), dimension(:) :: rdxzb ! for stoch phys. mtb-level
438
439 real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:)
440 integer, intent(in) :: spp_gwd
441
442 character(len=*), intent(out) :: errmsg
443 integer, intent(out) :: errflg
444
445! local variables
446 integer :: i, k
447 real(kind=kind_phys), dimension(im) :: sgh30
448 real(kind=kind_phys), dimension(im, levs) :: pdvdt, pdudt
449 real(kind=kind_phys), dimension(im, levs) :: pdtdt, pkdis
450!------------
451!
452! from ugwp_driver_v0.f -> cires_ugwp_initialize.F90 -> module ugwp_wmsdis_init
453! now in the namelist of cires_ugwp "knob_ugwp_tauamp" controls tamp_mpa
454!
455! tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2
456!------------
457! real(kind=kind_phys), parameter :: tamp_mpa_v0=30.e-3 ! large flux to help "GFS-ensembles" in July 2019
458
459! switches that activate impact of OGWs and NGWs
460
461! integer :: nmtvr_temp
462
463 real(kind=kind_phys), dimension(im, levs) :: zmet ! geopotential height at model Layer centers
464 real(kind=kind_phys), dimension(im, levs+1) :: zmeti ! geopotential height at model layer interfaces
465
466
467! ugwp_v1 local variables
468
469 integer :: y4, month, day, ddd_ugwp, curdate, curday, idtend
470
471! ugwp_v1 temporary (local) diagnostic variables from cires_ugwp_solv2_v1
472! diagnostics for wind and temp rms to compare with space-borne data and metrics
473! in the Middle atmosphere: 20-110 km ( not active in CCPP-style, oct 2020)
474! real(kind=kind_phys) :: tauabs(im,levs), wrms(im,levs), trms(im,levs)
475
476
477 ! Initialize CCPP error handling variables
478
479 errmsg = ''
480 errflg = 0
481
482! 1) ORO stationary GWs
483! ------------------
484!
485! for all oro-suites can uze geo-meters having "hpbl"
486!
487!
488! All GW-schemes operate with Zmet =phil*inv_g, passing Zmet/Zmeti can be more robust
489! + rho*dz = =delp * inv_g can be also pre-comp for all "GW-schemes"
490!
491 zmeti = phii* rgrav
492 zmet = phil* rgrav
493
494!===============================================================
495! ORO-diag
496
497 if (do_ugwp_v1 .or. ldiag_ugwp) then
498 dudt_ogw(:,:)= 0.; dvdt_ogw(:,:)=0.; dudt_obl(:,:)=0.; dvdt_obl(:,:)=0.
499 dudt_oss(:,:)= 0.; dvdt_oss(:,:)=0.; dudt_ofd(:,:)=0.; dvdt_ofd(:,:)=0.
500 du_ogwcol(:)=0. ; dv_ogwcol(:)=0. ; du_oblcol(:)=0. ; dv_oblcol(:)=0.
501 du_osscol(:)=0. ; dv_osscol(:)=0. ;du_ofdcol(:)=0. ; dv_ofdcol(:)=0.
502 dudt_ngw(:,:)=0.; dvdt_ngw(:,:)=0.; dtdt_ngw(:,:)=0.; kdis_ngw(:,:)=0.
503 else
504 dudt_ogw(:,:) = 0.
505 end if
506
507 dusfcg(:) = 0. ; dvsfcg(:) =0.
508
509
510! ngw+ogw - diag
511
512 dudt_gw(:,:)=0. ; dvdt_gw(:,:)=0. ; dtdt_gw(:,:)=0. ; kdis_gw(:,:)=0.
513! source fluxes
514
515 tau_ogw(:)=0. ; tau_ngw(:)=0. ; tau_oss(:)=0.
516
517! launch layers
518
519 zlwb(:)= 0. ; zogw(:)=0. ; zobl(:)=0. ; zngw(:)=0.
520!===============================================================
521! diag tendencies due to all-SSO schemes (ORO-physics)
522! ogw + obl + oss + ofd ..... no explicit "lee wave trapping"
523!===============================================================
524 do k=1,levs
525 do i=1,im
526 pdvdt(i,k) = 0.0
527 pdudt(i,k) = 0.0
528 pdtdt(i,k) = 0.0
529 pkdis(i,k) = 0.0
530 enddo
531 enddo
532!
533 ! Run the appropriate large-scale (large-scale GWD + blocking) scheme
534 ! Note: In case of GSL drag_suite, this includes ss and tofd
535
536 if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd) then
537!
538! to do: the zero diag and tendency values assigned inside "drag_suite_run" can be skipped :
539!
540! dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl,dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd
541! du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, du_osscol, dv_osscol, du_ofdcol dv_ofdcol
542! dusfcg, dvsfcg
543!
544!
545 if (do_gwd_opt_psl) then
546 call drag_suite_psl(im, levs, pdvdt, pdudt, pdtdt, &
547 ugrs,vgrs,tgrs,q1, &
548 kpbl,prsi,del,prsl,prslk,phii,phil,dtp, &
549 kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, &
550 ol4ss,theta,sigma,gamma,elvmax, &
551 dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, &
552 dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, &
553 dusfcg, dvsfcg, &
554 du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, &
555 du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, &
556 slmsk,br1,hpbl,vtype,con_g,con_cp,con_rd,con_rv, &
557 con_fv, con_pi, lonr, &
558 cdmbgwd(1:2),alpha_fd,me,master, &
559 lprnt,ipr,rdxzb,dx,gwd_opt, &
560 do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, &
561 psl_gwd_dx_factor, &
562 dtend, dtidx, index_of_process_orographic_gwd, &
563 index_of_temperature, index_of_x_wind, &
564 index_of_y_wind, ldiag3d, ldiag_ugwp, &
565 ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
566 else
567 call drag_suite_run(im, levs, pdvdt, pdudt, pdtdt, &
568 ugrs,vgrs,tgrs,q1, &
569 kpbl,prsi,del,prsl,prslk,phii,phil,dtp, &
570 kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, &
571 ol4ss,theta,sigma,gamma,elvmax, &
572 dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, &
573 dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, &
574 dusfcg, dvsfcg, &
575 du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, &
576 du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, &
577 slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, &
578 con_fv, con_pi, lonr, &
579 cdmbgwd(1:2),alpha_fd,me,master, &
580 lprnt,ipr,rdxzb,dx,gwd_opt, &
581 do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, &
582 dtend, dtidx, index_of_process_orographic_gwd, &
583 index_of_temperature, index_of_x_wind, &
584 index_of_y_wind, ldiag3d, ldiag_ugwp, &
585 ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg)
586 endif
587!
588! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol
589!
590! if (kdt <= 2 .and. me == master) then
591! print *, ' unified drag_suite_run ', kdt
592! print *, ' GSL drag du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400
593! print *, ' GSL drag dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400
594!
595! zero print *, ' unified drag_GSL dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400
596!
597! if (gwd_opt == 22 .or. gwd_opt == 33) then
598! print *, ' unified drag_GSL dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400
599! print *, ' unified drag_GSL dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400
600! print *, ' unified drag_GSL dUOGW/dt ', maxval(dudt_ogw)*86400, minval(dudt_ogw)*86400
601! print *, ' unified drag_GSL dVOGW/dt ', maxval(dvdt_ogw)*86400, minval(dvdt_ogw)*86400
602! print *, ' unified drag_GSL dUOss/dt ', maxval(dudt_oss)*86400, minval(dudt_oss)*86400
603! print *, ' unified drag_GSL dVOSS/dt ', maxval(dvdt_oss)*86400, minval(dvdt_oss)*86400
604! print *, ' unified drag_GSL dUOfd/dt ', maxval(dudt_ofd)*86400, minval(dudt_ofd)*86400
605! print *, ' unified drag_GSL dVOfd/dt ', maxval(dvdt_ofd)*86400, minval(dvdt_ofd)*86400
606! endif
607! endif
608
609 endif
610!
611! not gsldrag large-scale oro-scheme for example "do_ugwp_v1_orog_only"
612!
613
614 if ( do_ugwp_v1_orog_only ) then
615!
616! for TOFD we use now "varss" of GSL-drag /not sgh30=abs(oro-oro_f)/
617! only sum of integrated ORO+GW effects (dusfcg and dvsfcg) = sum(ogw + obl + oss*0 + ofd + ngw)
618!
619! OROGW_V1 introduce "orchestration" between OGW-effects and Mountain Blocking
620! it starts to examines options for the Scale-Aware (SA)formulation of SSO-effects
621! if ( me == master .and. kdt == 1) print *, ' bf orogw_v1 nmtvr=', nmtvr, ' do_tofd=', do_tofd
622
623 if (gwd_opt ==1 )sgh30 = 0.15*hprime ! portion of the mesoscale SSO (~[oro_unfilt -oro_filt)
624 if (gwd_opt >1 ) sgh30 = varss ! as in gsldrag: see drag_suite_run
625
626 call orogw_v1 (im, levs, lonr, me, master,dtp, kdt, do_tofd, &
627 xlat_d, sinlat, coslat, area, &
628 cdmbgwd(1:2), hprime, oc, oa4, clx, theta, &
629 sigma, gamma, elvmax, sgh30, kpbl, ugrs, &
630 vgrs, tgrs, q1, prsi,del,prsl,prslk, zmeti, zmet, &
631 pdvdt, pdudt, pdtdt, pkdis, dusfcg, dvsfcg,rdxzb, &
632 zobl, zlwb, zogw, tau_ogw, dudt_ogw, dvdt_ogw, &
633 dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd, &
634 du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, &
635 du_ofdcol, dv_ofdcol, errmsg,errflg )
636!
637! orogw_v1: dusfcg = du_ogwcol + du_oblcol + du_ofdcol only 3 terms
638!
639!
640! if (kdt <= 2 .and. me == master) then
641!
642! print *, ' unified_ugwp orogw_v1 ', kdt, me, nmtvr
643! print *, ' unified_ugwp orogw_v1 du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400
644! print *, ' unified_ugwp orogw_v1 dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400
645! print *, ' unified_ugwp orogw_v1 dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400
646! print *, ' unified_ugwp orogw_v1 dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400
647! print *, ' unified_ugwp orogw_v1 dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400
648! endif
649
650
651 end if
652!
653! for old-fashioned GFS-style diag-cs like dt3dt(:.:, 1:14) collections
654!
655 if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then
656 idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd)
657 if(idtend>=1) then
658 dtend(:,:,idtend) = dtend(:,:,idtend) + pdudt*dtp
659 endif
660 idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd)
661 if(idtend>=1) then
662 dtend(:,:,idtend) = dtend(:,:,idtend) + pdvdt*dtp
663 endif
664 idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd)
665 if(idtend>=1) then
666 dtend(:,:,idtend) = dtend(:,:,idtend) + pdtdt*dtp
667 endif
668 endif
669!
670!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
671! Begin non-stationary GW schemes
672! ugwp_v1
673!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
674
675 if (do_ugwp_v1) then
676
677!==================================================================
678! call slat_geos5_tamp_v1(im, tamp_mpa, xlat_d, tau_ngw)
679!
680! 2020 updates of MERRA/GEOS tau_ngw for the C96-QBO FV3GFS-127L runs
681!==================================================================
682
683 call slat_geos5_2020(im, tamp_mpa, xlat_d, tau_ngw)
684
685 y4 = jdat(1); month = jdat(2); day = jdat(3)
686!
687! hour = jdat(5)
688! fhour = float(hour)+float(jdat(6))/60. + float(jdat(7))/3600.
689! fhour = (kdt-1)*dtp/3600.
690! fhrday = fhour/24. - nint(fhour/24.)
691
692
693 call calendar_ugwp(y4, month, day, ddd_ugwp)
694 curdate = y4*1000 + ddd_ugwp
695!
696 call ngwflux_update(me, master, im, levs, kdt, ddd_ugwp,curdate, &
697 tau_amf, xlat_d, sinlat,coslat, rain, tau_ngw)
698
699 call cires_ugwpv1_ngw_solv2(me, master, im, levs, kdt, dtp, &
700 tau_ngw, tgrs, ugrs, vgrs, q1, prsl, prsi, &
701 zmet, zmeti,prslk, xlat_d, sinlat, coslat, &
702 dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, zngw)
703!
704! => con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt
705!
706! if (me == master .and. kdt <= 2) then
707! print *
708! write(6,*)'FV3GFS finished fv3_ugwp_solv2_v1 '
709! write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing '
710! print *
711!
712! print *, ' ugwp_v1 ', kdt
713! print *, ' ugwp_v1 du/dt ', maxval(dudt_ngw)*86400, minval(dudt_ngw)*86400
714! print *, ' ugwp_v1 dv/dt ', maxval(dvdt_ngw)*86400, minval(dvdt_ngw)*86400
715! print *, ' ugwp_v1 dT/dt ', maxval(dtdt_ngw)*86400, minval(dtdt_ngw)*86400
716! endif
717
718
719 end if ! do_ugwp_v1
720
721 if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then
722 idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd)
723 if(idtend>=1) then
724 dtend(:,:,idtend) = dtend(:,:,idtend) + dudt_ngw(i,k)*dtp
725 endif
726 idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd)
727 if(idtend>=1) then
728 dtend(:,:,idtend) = dtend(:,:,idtend) + dvdt_ngw(i,k)*dtp
729 endif
730 idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd)
731 if(idtend>=1) then
732 dtend(:,:,idtend) = dtend(:,:,idtend) + dtdt_ngw(i,k)*dtp
733 endif
734 endif
735
736!
737! get total sso-OGW + NGW
738!
739 if (do_ugwp_v1) then
740 dudt_gw = pdudt + dudt_ngw
741 dvdt_gw = pdvdt + dvdt_ngw
742 dtdt_gw = pdtdt + dtdt_ngw
743 kdis_gw = pkdis + kdis_ngw
744 else
745 dudt_gw = pdudt
746 dvdt_gw = pdvdt
747 dtdt_gw = pdtdt
748 kdis_gw = pkdis
749 end if
750!
751! accumulate "tendencies" as in the GFS-ipd (pbl + ugwp + zero-RF)
752!
753 dudt = dudt + dudt_gw
754 dvdt = dvdt + dvdt_gw
755 dtdt = dtdt + dtdt_gw
756
757 end subroutine ugwpv1_gsldrag_run
758end module ugwpv1_gsldrag
This module contains the orographic gravity wave drag scheme.
Definition drag_suite.F90:6