!##################################################################
!##################################################################
!######                                                      ######
!######                 SUBROUTINE ADJTSFC                   ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!

SUBROUTINE adjtsfc(nx,ny,nz,rbufsz,                                     & 1,1
           ptprt,pprt,qv,qc,qr,qi,qs,qh,                                &
           ptbar,pbar,ppi,rhostr,                                       &
           x,y,z,zp,j3inv,                                              &
           soiltyp, tsfc, wetsfc,snowdpth,                              &
           radfrc, radsw, rnflx,                                        &
           rsirbm,rsirdf,rsuvbm,rsuvdf,                                 &
           cosz, cosss,                                                 &
           fdirir,fdifir,fdirpar,fdifpar,st4,                           &
           tem1,tem2,tem3,tem4,tem5,tem6,tem7,tem8,                     &
           tem9,tem10,tem11,tem12,tem13,tem14,tem15,tem16,              &
           radbuf)
  IMPLICIT NONE
  INTEGER :: nx,ny,nz
  INTEGER :: rbufsz
!
!-----------------------------------------------------------------------
!
!  Define ARPS variables
!
!-----------------------------------------------------------------------
!
  REAL, INTENT(IN) :: ptprt (nx,ny,nz)
  REAL, INTENT(IN) :: pprt  (nx,ny,nz)
  REAL, INTENT(IN) :: qv    (nx,ny,nz)
  REAL, INTENT(IN) :: qc    (nx,ny,nz)
  REAL, INTENT(IN) :: qr    (nx,ny,nz)
  REAL, INTENT(IN) :: qi    (nx,ny,nz)
  REAL, INTENT(IN) :: qs    (nx,ny,nz)
  REAL, INTENT(IN) :: qh    (nx,ny,nz)

  REAL, INTENT(IN) :: ptbar (nx,ny,nz)
  REAL, INTENT(IN) :: pbar  (nx,ny,nz)
  REAL, INTENT(IN) :: ppi   (nx,ny,nz)
  REAL, INTENT(IN) :: rhostr(nx,ny,nz)

  REAL, INTENT(IN) :: x      (nx)
  REAL, INTENT(IN) :: y      (ny)
  REAL, INTENT(IN) :: z      (nz)

  REAL, INTENT(IN) :: zp    (nx,ny,nz)  ! The physical height coordinate defined at
                                        ! w-point of staggered grid.
  REAL, INTENT(IN) :: j3inv (nx,ny,nz)

  INTEGER :: soiltyp(nx,ny)             ! Soil type at each point
  REAL, INTENT(INOUT) :: tsfc   (nx,ny)
  REAL, INTENT(IN) :: wetsfc (nx,ny)    ! Surface soil moisture in the top 1 cm layer
  REAL, INTENT(IN) :: snowdpth(nx,ny)   ! Snow depth (m)

  REAL, INTENT(OUT) :: radfrc(nx,ny,nz) ! Radiation forcing (K/s)
  REAL, INTENT(OUT) :: radsw  (nx,ny)   ! Solar radiation down to the surface
  REAL, INTENT(OUT) :: rnflx  (nx,ny)   ! Net radiation flux absorbed by surface

  REAL, INTENT(OUT) :: rsirbm(nx,ny)    ! Solar IR surface albedo for beam radiation
  REAL, INTENT(OUT) :: rsirdf(nx,ny)    ! Solar IR surface albedo for diffuse radiation
  REAL, INTENT(OUT) :: rsuvbm(nx,ny)    ! Solar UV surface albedo for beam radiation
  REAL, INTENT(OUT) :: rsuvdf(nx,ny)    ! Solar UV surface albedo for diffuse radiation

  REAL, INTENT(OUT) :: cosz  (nx,ny)    ! Cosine of zenith
  REAL, INTENT(OUT) :: cosss (nx,ny)    ! Cosine of angle between sun light and
                                        ! surface terrain slope

  REAL, INTENT(OUT) :: fdirir (nx,ny)   ! all-sky direct downward IR flux
                                        ! (0.7-10 micron) at the surface
  REAL, INTENT(OUT) :: fdifir (nx,ny)   ! all-sky diffuse downward IR flux
                                        ! at the surface
  REAL, INTENT(OUT) :: fdirpar(nx,ny)   ! all-sky direct downward par flux
                                        ! (0.4-0.7 micron) at the surface
  REAL, INTENT(OUT) :: fdifpar(nx,ny)   ! all-sky diffuse downward par flux
                                        ! at the surface
  REAL, INTENT(OUT) :: st4(nx,ny)       ! all-sky diffuse downward par flux
                                        ! at the surface
  REAL, INTENT(INOUT) :: tem1(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem2(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem3(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem4(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem5(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem6(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem7(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem8(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem9(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem10(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem11(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem12(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem13(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem14(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem15(nx,ny,nz)
  REAL, INTENT(INOUT) :: tem16(nx,ny,nz)
  REAL, INTENT(INOUT) :: radbuf(rbufsz) ! temporary arrays used for radiation
                                        ! transfer computing
!
! Misc Local Variables
!
  INTEGER :: i,j
  REAL :: zs2,zs3,tk2,tk3,dtdz,tdiff,t2m,p0inv
!
! Temperature tuning parameters based on Mesonet data studies
! These are from Marena, 2000 OASIS data.
! A relatively conservative slope for dT/d(rnflx)
! 
  REAL, PARAMETER :: ptd0 = -0.66     ! degrees K
  REAL, PARAMETER :: ptd1 =  0.011    ! degrees K / (W/m2)
  REAL, PARAMETER :: ptdifmax = 10.
  REAL, PARAMETER :: ptdifmin = -5.
!
! Include files
!
  INCLUDE 'phycst.inc'
!
! Misc initializations
!
  p0inv=1./p0
!
! Call radiation package to get radiation at the surface
!
  CALL radiation(nx,ny,nz,rbufsz,                                     &
                 ptprt,pprt,qv,qc,qr,qi,qs,qh,                        &
                 ptbar,pbar,ppi, rhostr,                              &
                 x,y,z,zp, j3inv,                                     &
                 soiltyp,tsfc,wetsfc,snowdpth,                        &
                 radfrc, radsw,rnflx,                                 &
                 rsirbm,rsirdf,rsuvbm,rsuvdf,cosz,cosss,              &
                 fdirir,fdifir,fdirpar,fdifpar,                       &
                 tem1,tem2,tem3,tem4,tem5,                            &
                 tem6,tem7,tem8,tem9,tem10,                           &
                 tem11,tem12,tem13,tem14,tem15,tem16,                 &
                 radbuf)
  DO j=1,ny-1
    DO i=1,nx-1
!
! Estimate temperature offset from net radiation.
! Extrapolate k=2 and k=3 temperatures to shelter height (2m)
! Then apply tdiff from regression of 2m temps vs. skin temp
!
      IF(soiltyp(i,j) < 12 .OR. soiltyp(i,j) > 13) THEN
        zs3=0.5*(zp(i,j,3)+zp(i,j,4))
        zs2=0.5*(zp(i,j,2)+zp(i,j,3))
        tk3=(ptbar(i,j,3)+ptprt(i,j,3))*                           &
            ((pbar(i,j,3)+pprt(i,j,3))*p0inv)**rddcp
        tk2=(ptbar(i,j,2)+ptprt(i,j,2))*                           &
            ((pbar(i,j,2)+pprt(i,j,2))*p0inv)**rddcp
        dtdz=(tk3-tk2)/(zs3-zs2)
        t2m=tk2+dtdz*((zp(i,j,2)+2.)-zs2)
        tdiff=ptd0+ptd1*rnflx(i,j)
        tsfc(i,j)=t2m+tdiff
      END IF
    END DO
  END DO
  RETURN
END SUBROUTINE adjtsfc