!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer, 
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms 
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer 
!version 3 or (at your option) any later version that should be found at: 
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html 
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software; 
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), 
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
*** S/P SLTOP_TQ
*
#include "phy_macros_f.h"

      subroutine sltop_tq(ft,dtdz,ttop,tsurf,ztop,z0t,ilmo,h,n),2
*
      IMPLICIT NONE
      REAL FT(N),DTDZ(N),TTOP(N),TSURF(N),ZTOP(N),Z0T(N)
      REAL ILMO(N),H(N)
*
*Author
*          Yves Delage  (Oct 2003)
*
*Revision
*
*Object
*     Calculates the surface flux and the slope of the temperature
*      or humidity profile at the top of the surface layer (SL)
*
*Arguments
*
*          - Output -
* FT      normalised temperature or humidity flux at surface
* DTDZ    slope of temperature or humidity profile at top of SL
*
*          - Input -
* TTOP    temperature or humidity at the top of surface layer
* TSURF   temperature or humidity at the surface
* ZTOP    height of the top of the surface layer
* Z0T     roughness length for temperature/humidity
* ILMO    inverse of MONIN-OBUKHOV lenth
* H       height of boundary layer (for stable case only)
* N       number of horizontal points to process
*
      INTEGER N,J
*
****************************************************************
*     AUTOMATIC ARRAYS
      AUTOMATIC ( FH , REAL , (N) )
****************************************************************
      REAL AS,ASX,CI,BS,BETA,FACTN,HMIN,ANGMAX,RAC3
*
#include "surfcon_ini.cdk"
*
      call slfun_tq(fh,ztop,z0t,ilmo,h,n)
      DO J=1,N
        ft(j)=(ttop(j)-tsurf(j))/fh(j)
        dtdz(j)=ft(j)*phih(ztop(j),ilmo(j),h(j))/(ztop(j)+z0t(j))
      END DO
*
      return
      CONTAINS
#include "deriv_stabfunc.cdk"
      end