!-------------------------------------- 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 SLFUN_TQ
*
#include "phy_macros_f.h"
subroutine slfun_tq(fh,z,z0t,ilmo,h,n) 1,3
*
IMPLICIT NONE
REAL FH(N),Z(N),Z0T(N),ILMO(N),H(N)
*
*Author
* Yves Delage (Oct 2003)
*
*Revision
* 001 R. McTaggart-Cowan and B. Bilodeau (May 2006) -
* Clean up stabfunc.cdk
*
*Object
* Calculates the integrated surface-layer functions for interpolating
* temperature, humidity and other passive variables
*
*Arguments
*
* - Output -
* FH normalised temperature or humidity value at desired height
*
* - Input -
* Z height of desired output
* 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
REAL AS,ASX,CI,BS,BETA,FACTN,HMIN,ANGMAX,RAC3
*
REAL X,X0,Y,Y0,Z0(1),HI,LZZ0(1)
*
*********************************************************************
* AUTOMATIC ARRAYS
AUTOMATIC ( LZZ0T , REAL , (N) )
*********************************************************************
*
#include "surfcon_ini.cdk"
*
DO J=1,N
LZZ0T(J)=LOG(Z(J)/Z0T(J)+1)
IF(ILMO(J).LE.0.) THEN
*---------------------------------------------------------------------
* UNSTABLE CASE
FH(J)= fhi(z(j)+z0t(j),Z0T(J),LZZ0T(J),ILMO(J),Y,Y0)
ELSE
*---------------------------------------------------------------------
* STABLE CASE
hi=1/MAX(H(J),hmin,factn/(4*AS*BETA*ilmo(j)),
1 (Z(J)+10*Z0T(J))*factn)
fh(j)=BETA*(LZZ0T(J)+min(psi(Z(J)+Z0T(J),HI,ILMO(J))-
1 psi(Z0T(J),HI,ILMO(J)), ASX*BETA*ILMO(J)*Z(J)))
ENDIF
*---------------------------------------------------------------------
END DO
*
return
CONTAINS
#include "stabfunc2.cdk"
end