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)
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
348 logical,
intent(in) :: ldiag3d, lssav
349 logical,
intent(in) :: flag_for_gwd_generic_tend
350 logical,
intent(in) :: lprnt
352 integer,
intent(in) :: ipr
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
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(:)
366 logical,
intent(in) :: do_gwd_opt_psl
367 real(kind=kind_phys),
intent(in) :: psl_gwd_dx_factor
369 integer,
intent(in) :: gwd_opt
370 integer,
intent(in) :: nmtvr
371 real(kind=kind_phys),
intent(in) :: cdmbgwd(:), alpha_fd
373 real(kind=kind_phys),
intent(in),
dimension(:) :: hprime, oc, theta, sigma, gamma
375 real(kind=kind_phys),
intent(in),
dimension(:) :: elvmax
376 real(kind=kind_phys),
intent(in),
dimension(:,:) :: clx, oa4
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
389 real(kind=kind_phys),
intent(in),
dimension(:) :: xlat, xlat_d, sinlat, coslat, area
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
399 real(kind=kind_phys),
intent(in),
dimension(:) :: rain
400 real(kind=kind_phys),
intent(in),
dimension(:) :: br1, hpbl, slmsk
405 real(kind=kind_phys),
intent(in),
dimension(:) :: tau_amf
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
416 real(kind=kind_phys),
intent(out),
dimension(:) :: dusfcg, dvsfcg
417 real(kind=kind_phys),
intent(out),
dimension(:) :: tau_ogw, tau_ngw, tau_oss
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
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
426 real(kind=kind_phys),
intent(out) ,
dimension(:) :: zogw, zlwb, zobl, zngw
429 real(kind=kind_phys),
intent(inout),
dimension(:,:) :: dudt, dvdt, dtdt
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
437 real(kind=kind_phys),
intent(out),
dimension(:) :: rdxzb
439 real(kind=kind_phys),
intent(in),
optional :: spp_wts_gwd(:,:)
440 integer,
intent(in) :: spp_gwd
442 character(len=*),
intent(out) :: errmsg
443 integer,
intent(out) :: errflg
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
463 real(kind=kind_phys),
dimension(im, levs) :: zmet
464 real(kind=kind_phys),
dimension(im, levs+1) :: zmeti
469 integer :: y4, month, day, ddd_ugwp, curdate, curday, idtend
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.
507 dusfcg(:) = 0. ; dvsfcg(:) =0.
512 dudt_gw(:,:)=0. ; dvdt_gw(:,:)=0. ; dtdt_gw(:,:)=0. ; kdis_gw(:,:)=0.
515 tau_ogw(:)=0. ; tau_ngw(:)=0. ; tau_oss(:)=0.
519 zlwb(:)= 0. ; zogw(:)=0. ; zobl(:)=0. ; zngw(:)=0.
536 if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd)
then
545 if (do_gwd_opt_psl)
then
546 call drag_suite_psl(im, levs, pdvdt, pdudt, pdtdt, &
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, &
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, &
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)
567 call drag_suite_run(im, levs, pdvdt, pdudt, pdtdt, &
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, &
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)
614 if ( do_ugwp_v1_orog_only )
then
623 if (gwd_opt ==1 )sgh30 = 0.15*hprime
624 if (gwd_opt >1 ) sgh30 = varss
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 )
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)
658 dtend(:,:,idtend) = dtend(:,:,idtend) + pdudt*dtp
660 idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd)
662 dtend(:,:,idtend) = dtend(:,:,idtend) + pdvdt*dtp
664 idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd)
666 dtend(:,:,idtend) = dtend(:,:,idtend) + pdtdt*dtp
683 call slat_geos5_2020(im, tamp_mpa, xlat_d, tau_ngw)
685 y4 = jdat(1); month = jdat(2); day = jdat(3)
693 call calendar_ugwp(y4, month, day, ddd_ugwp)
694 curdate = y4*1000 + ddd_ugwp
696 call ngwflux_update(me, master, im, levs, kdt, ddd_ugwp,curdate, &
697 tau_amf, xlat_d, sinlat,coslat, rain, tau_ngw)
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)
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)
724 dtend(:,:,idtend) = dtend(:,:,idtend) + dudt_ngw(i,k)*dtp
726 idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd)
728 dtend(:,:,idtend) = dtend(:,:,idtend) + dvdt_ngw(i,k)*dtp
730 idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd)
732 dtend(:,:,idtend) = dtend(:,:,idtend) + dtdt_ngw(i,k)*dtp
740 dudt_gw = pdudt + dudt_ngw
741 dvdt_gw = pdvdt + dvdt_ngw
742 dtdt_gw = pdtdt + dtdt_ngw
743 kdis_gw = pkdis + kdis_ngw
753 dudt = dudt + dudt_gw
754 dvdt = dvdt + dvdt_gw
755 dtdt = dtdt + dtdt_gw