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.

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

Update vertical interpolation stand-alone, fix vert_interp call #1337

Merged
merged 1 commit into from
Jan 4, 2021
Merged
Changes from all commits
Commits
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
22 changes: 15 additions & 7 deletions dyn_em/module_initialize_real.F
Original file line number Diff line number Diff line change
Expand Up @@ -4930,6 +4930,8 @@ END SUBROUTINE find_my_parent2

#ifdef VERT_UNIT

!gfortran -DVERT_UNIT -ffree-form -ffree-line-length-none module_initialize_real.F -o vert.exe

!This is a main program for a small unit test for the vertical interpolation.

program vint
Expand Down Expand Up @@ -4961,6 +4963,7 @@ program vint
logical, parameter :: use_surface = .TRUE. ! .FALSE. ! .TRUE.
real , parameter :: zap_close_levels = 500. ! 100.
integer, parameter :: force_sfc_in_vinterp = 6 ! 0 ! 6
integer, parameter :: id = 1

integer :: k

Expand All @@ -4975,7 +4978,7 @@ program vint
print *,'UNIT TEST FOR VERTICAL INTERPOLATION'
print *,'------------------------------------'
print *,' '
do lagrange_order = 1 , 9 , 8
do lagrange_order = 1 , 1
print *,' '
print *,'------------------------------------'
print *,'Lagrange Order = ',lagrange_order
Expand Down Expand Up @@ -5006,7 +5009,7 @@ program vint
generic , 'T' , &
interp_type , lagrange_order , extrap_type , &
lowest_lev_from_sfc , use_levels_below_ground , use_surface , &
zap_close_levels , force_sfc_in_vinterp , &
zap_close_levels , force_sfc_in_vinterp , id , &
ids , ide , jds , jde , kds , kde , &
ims , ime , jms , jme , kms , kme , &
its , ite , jts , jte , kts , kte )
Expand Down Expand Up @@ -5052,8 +5055,6 @@ subroutine fillitup ( fo , po , fn , pn , &

integer :: i , j , k

real , parameter :: piov2 = 3.14159265358 / 2.

k = 1
do j = jts , jte
do i = its , ite
Expand All @@ -5065,6 +5066,7 @@ subroutine fillitup ( fo , po , fn , pn , &
do j = jts , jte
do i = its , ite
po(i,k,j) = ( 5000. * ( 1 - (k-1) ) + 100000. * ( (k-1) - (generic-1) ) ) / (1. - real(generic-1) )
! po(i,k,j) = FILL IN YOUR INPUT PRESSURE LEVELS
end do
end do
end do
Expand All @@ -5074,7 +5076,7 @@ subroutine fillitup ( fo , po , fn , pn , &
do j = jts , jte
do i = its , ite
fo(i,k,j) = po(i,k,j)
! fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. )
! fo(i,k,j) = FILL IN YOUR COLUMN OF PRESS_LEVEL FIELD
end do
end do
end do
Expand All @@ -5083,7 +5085,6 @@ subroutine fillitup ( fo , po , fn , pn , &
do j = jts , jte
do i = its , ite
fo(i,k,j) = (((po(i,k,j)-5000.)/102000.)*((102000.-po(i,k,j))/102000.))*102000.
! fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. )
end do
end do
end do
Expand All @@ -5095,6 +5096,7 @@ subroutine fillitup ( fo , po , fn , pn , &
do j = jts , jte
do i = its , ite
pn(i,k,j) = ( 5000. * ( 0 - (k-1) ) + 102000. * ( (k-1) - (kte-1) ) ) / (-1. * real(kte-1) )
! pn(i,k,j) = FILL IN A COLUMN OF KNOWN FULL-LEVEL PRESSURES ON ETA SURFACES
end do
end do
end do
Expand All @@ -5113,7 +5115,7 @@ subroutine fillitup ( fo , po , fn , pn , &
do j = jts , jte
do i = its , ite
fn(i,k,j) = pn(i,k,j)
! fn(i,k,j) = sin(pn(i,k,j) * piov2 / 102000. )
! fn(i,k,j) = FILL IN COLUMN OF HALF LEVEL FIELD
end do
end do
end do
Expand All @@ -5137,6 +5139,12 @@ function skip_middle_points_t ( ids , ide , jds , jde , i , j , em_width , hold_
skip_middle_points_t = .false.
end function skip_middle_points_t

subroutine wrf_message(level,message)
character(len=*), intent(in) :: message
integer, intent(in) :: level
print *,trim(message)
end subroutine wrf_message

#endif

!---------------------------------------------------------------------
Expand Down