Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Only YSU changes #4

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Only YSU changes #4

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
98 changes: 25 additions & 73 deletions bl_ysu.F → bl_ysu.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,27 +1,28 @@
#define NEED_B4B_DURING_CCPP_TESTING 1
!=================================================================================================================
module bl_ysu
use ccpp_kinds,only: kind_phys
use machine,only: kind_phys
Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@ldfowler58 This will need to be changed to something that works across hosts. Maybe pre-pocessor directives? Something like
#ifdef CCPP
use machine,only: kind_phys
#else
use maybe_something_MPAS, only: kind_phys => MPAS_kind_phys
#endif


implicit none
private
public:: bl_ysu_run , &
bl_ysu_init , &
bl_ysu_final , &
bl_ysu_finalize , &
bl_ysu_timestep_init, &
bl_ysu_timestep_final

bl_ysu_timestep_finalize

contains


!> \section arg_table_bl_ysu_run
!! \htmlinclude bl_ysu_run.html
!!
!=================================================================================================================
subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
f_qc,f_qi, &
utnp,vtnp,ttnp,qvtnp,qctnp,qitnp,qmixtnp, &
cp,g,rovcp,rd,rovg,ep1,ep2,karman,xlv,rv, &
dz8w2d,psfcpa, &
znt,ust,hpbl,psim,psih, &
znt,ust,hpbl,dusfc,dvsfc,dtsfc,dqsfc,psim,psih, &
xland,hfx,qfx,wspd,br, &
dt,kpbl1d, &
exch_hx,exch_mx, &
Expand Down Expand Up @@ -119,7 +120,7 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
!
integer, intent(in ) :: its,ite,kte,kme

integer, intent(in) :: ysu_topdown_pblmix
logical, intent(in) :: ysu_topdown_pblmix
!
integer, intent(in) :: nmix
!
Expand Down Expand Up @@ -160,7 +161,11 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
intent(in ) :: p2d
!
real(kind=kind_phys), dimension( its:ite ) , &
intent(out ) :: hpbl
intent(out ) :: hpbl, &
dusfc,&
dvsfc,&
dtsfc,&
dqsfc
!
real(kind=kind_phys), dimension( its:ite ) , &
intent(in ) :: ust, &
Expand Down Expand Up @@ -235,8 +240,6 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
hgamt,hgamq, &
brdn,brup, &
phim,phih, &
dusfc,dvsfc, &
dtsfc,dqsfc, &
prpbl, &
wspd1,thermalli
!
Expand Down Expand Up @@ -330,12 +333,14 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
real(kind=kind_phys), dimension( its:ite ) :: &
frc_urb1d

real(kind=kind_phys), dimension( kts:kte ) :: thvx_1d,tke_1d,dzq_1d
real(kind=kind_phys), dimension( kts:kte+1) :: zq_1d
real(kind=kind_phys), dimension( kts:kte ) :: dummy1,dummy2,dummy4
real(kind=kind_phys), dimension( kms:kme ) :: dummy3

real(kind=kind_phys):: temp1,temp2
!
!-------------------------------------------------------------------------------
!

klpbl = kte
!
cont=cp/g
Expand Down Expand Up @@ -688,7 +693,7 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
!
! enhance pbl by theta-li
!
if (ysu_topdown_pblmix.eq.1)then
if (ysu_topdown_pblmix)then
do i = its,ite
kpblold(i) = kpbl(i)
definebrup=.false.
Expand Down Expand Up @@ -795,7 +800,7 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
bfxpbl(i) = -0.15*thvx(i,1)/g*wm3/hpbl(i)
dthvx(i) = max(thvx(i,k+1)-thvx(i,k),tmin)
we(i) = max(bfxpbl(i)/dthvx(i),-sqrt(wm2(i)))
if((qcxl(i,k)+qixl(i,k)).gt.0.01e-3.and.ysu_topdown_pblmix.eq.1)then
if((qcxl(i,k)+qixl(i,k)).gt.0.01e-3.and.ysu_topdown_pblmix)then
if ( kpbl(i) .ge. 2) then
cloudflg(i)=.true.
templ=thlix(i,k)*(p2di(i,k+1)/100000)**rovcp
Expand Down Expand Up @@ -1240,13 +1245,13 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
! CALL GET_PBLH(KTS,KTE,pblh_ysu(i),thvx(i,kts:kte),&
! & tke_ysu(i,kts:kte),zq(i,kts:kte+1),dzq(i,kts:kte),xland(i))
do k = kts,kte
thvx_1d(k) = thvx(i,k)
tke_1d(k) = tke_ysu(i,k)
zq_1d(k) = zq(i,k)
dzq_1d(k) = dzq(i,k)
dummy1(k) = thvx(i,k)
dummy2(k) = tke_ysu(i,k)
dummy3(k) = zq(i,k)
dummy4(k) = dzq(i,k)
enddo
zq_1d(kte+1) = zq(i,kte+1)
call get_pblh(kts,kte,pblh_ysu(i),thvx_1d,tke_1d,zq_1d,dzq_1d,xland(i))
dummy3(kte+1) = zq(i,kte+1)
call get_pblh(kts,kte,pblh_ysu(i),dummy1,dummy2,dummy3,dummy4,xland(i))

!--- end of paj tke
! compute vconv
Expand Down Expand Up @@ -1377,59 +1382,6 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, &
!
end subroutine bl_ysu_run

!=================================================================================================================
subroutine bl_ysu_init (errmsg, errflg)

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! This routine currently does nothing

errmsg = ''
errflg = 0

end subroutine bl_ysu_init

!=================================================================================================================
subroutine bl_ysu_final (errmsg, errflg)

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! This routine currently does nothing

errmsg = ''
errflg = 0

end subroutine bl_ysu_final

!=================================================================================================================
subroutine bl_ysu_timestep_init (errmsg, errflg)

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! This routine currently does nothing

errmsg = ''
errflg = 0

end subroutine bl_ysu_timestep_init

!=================================================================================================================
subroutine bl_ysu_timestep_final (errmsg, errflg)

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! This routine currently does nothing

errmsg = ''
errflg = 0

end subroutine bl_ysu_timestep_final
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
subroutine tridi2n(cl,cm,cm1,cu,r1,r2,au,f1,f2,its,ite,kts,kte,nt)
!-------------------------------------------------------------------------------
Expand Down
Loading