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)
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
281 real(kind=kind_phys),
intent(in),
dimension(:,:),
optional :: oa4ss,ol4ss
283 logical,
intent(in) :: flag_for_gwd_generic_tend
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
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(:), &
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
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
327 real(kind=kind_phys),
intent(inout),
dimension(:,:),
optional :: du3dt_mtb, du3dt_ogw, du3dt_tms
329 real(kind=kind_phys),
intent(inout),
dimension(:,:) :: dudt, dvdt, dtdt
331 real(kind=kind_phys),
intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, &
332 con_rv, con_rerth, con_fvirt
334 real(kind=kind_phys),
intent(in),
dimension(:) :: rain
336 integer,
intent(in) :: ntke
337 real(kind=kind_phys),
intent(in),
dimension(:,:) :: q_tke, dqdt_tke
339 logical,
intent(in) :: lprnt
340 integer,
intent(in) :: ipr
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, &
348 real(kind=kind_phys),
intent(in),
optional :: spp_wts_gwd(:,:)
349 integer,
intent(in) :: spp_gwd
352 logical,
intent(in) :: do_gwd_opt_psl
353 real(kind=kind_phys),
intent(in) :: psl_gwd_dx_factor
355 character(len=*),
intent(out) :: errmsg
356 integer,
intent(out) :: errflg
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
369 real(kind=kind_phys),
dimension(im, levs) :: uwnd1, vwnd1
371 real(kind=kind_phys),
parameter :: tamp_mpa=30.e-3
373 integer :: nmtvr_temp, idtend
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
379 real(kind=kind_phys) :: inv_g
380 real(kind=kind_phys),
dimension(im, levs) :: zmet
381 real(kind=kind_phys),
dimension(im, levs+1) :: zmeti
404 if ( ldiag_ugwp )
then
427 if ( do_ugwp_v0.or.do_ugwp_v0_orog_only.or.do_ugwp_v0_nst_only )
then
442 uwnd1(:,:) = ugrs(:,:)
443 vwnd1(:,:) = vgrs(:,:)
445 if ( do_ugwp_v0.or.do_ugwp_v0_orog_only )
then
447 if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0)
then
451 if ( nmtvr == 24 )
then
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
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
478 tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0
480 du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0
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)
487 dtend(:,:,idtend) = dtend(:,:,idtend) + pdudt*dtp
490 idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd)
492 dtend(:,:,idtend) = dtend(:,:,idtend) + pdvdt*dtp
495 idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd)
497 dtend(:,:,idtend) = dtend(:,:,idtend) + pdtdt*dtp
508 if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd )
then
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, &
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)
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)
551 tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0.
552 dudt_mtb = 0. ; dudt_tms = 0.
565 if (do_ugwp_v0.or.do_ugwp_v0_nst_only)
then
567 if (cdmbgwd(3) > 0.0)
then
570 call slat_geos5_tamp_v0(im, tamp_mpa, xlat_d, tau_ngw)
572 if (abs(1.0-cdmbgwd(3)) > 1.0e-6)
then
573 if (cdmbgwd(4) > 0.0)
then
574 allocate(turb_fac(im))
579 allocate(tke(im,levs))
581 tke(:,:) = q_tke(:,:) + dqdt_tke(:,:) * dtp
585 turb_fac(i) = turb_fac(i) + del(i,k) * tke(i,k)
586 tem(i) = tem(i) + del(i,k)
590 turb_fac(i) = turb_fac(i) / tem(i)
595 rfac = 86400000 / dtp
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))
603 tau_ngw(i) = tau_ngw(i) * cdmbgwd(3)
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)
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)
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)
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)
645 dtend(:,:,idtend) = dtend(:,:,idtend) + pdudt*dtp
648 idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd)
650 dtend(:,:,idtend) = dtend(:,:,idtend) + pdvdt*dtp
653 idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd)
655 dtend(:,:,idtend) = dtend(:,:,idtend) + pdtdt*dtp
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.