!-------------------------------------- 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 UPDATE
*
#include "phy_macros_f.h"
SUBROUTINE UPDATE ( TS, T2, WG, W2, WR, WS,
1 ALPHAS, RHOS, SELOC,
1 VMOD, CD, RHOA, HFLUX, LE, TSFC, QSFC, PS, T,
1 HUSURF, TST, T2T, WGT, W2T, WRT, WST,
1 ALPHAST, RHOST, GAMAZA,
1 BM, FQ, FC, FV, AT, BT, AQ,
1 N, NK )
*
#include "impnone.cdk"
*
INTEGER N, NK
REAL TS(N), T2(N), WG(N), W2(N), WR(N), WS(N)
REAL ALPHAS(N), RHOS(N), T(N), HUSURF(N)
REAL SELOC(N,NK), VMOD(N), CD(N), RHOA(N)
REAL HFLUX(N), LE(N), TSFC(N), QSFC(N), PS(N)
REAL TST(N), T2T(N), WGT(N), W2T(N), WRT(N), WST(N)
REAL ALPHAST(N), RHOST(N), GAMAZA(N)
REAL BM(N), FQ(N), FC(N), FV(N), AT(N,NK)
REAL BT(N), AQ(N,NK)
*
*Author
* S. Belair (January 1997)
*Revisions
* 001 B. Bilodeau (January 2001) - Automatic arrays
*
*Object
* Update the prognostic variables
*
*Arguments
*
* - Input/Output -
* TS
* T2
* WG
* W2 prognostic variables at time -
* WR
* WS
* ALPHAS
* RHOS
*
*
* - Input -
*
* SELOC local sigma levels
* VMOD module of the low-level wind
* CD surface transfer coefficient for momentum
* RHOA low-level air density
* HFLUX surface flux of sensible heat
* LE surface flux of latent heat
* TSFC surface temperature
* PS surface pressure
* T low-level air temperature
* HUSURF surface specific humidity
*
* - Output -
* TST
* T2T
* WGT
* W2T prognostic variables at time +
* WRT
* WST
* ALPHAST
* RHOST
*
* BM homogeneous boundary condition term in the
* diffusion equation for U and V
* BT homogeneous boundary condition term in the
* diffusion equation for Theta and Q
* FQ surface momentum flux
* FC surface sensible heat flux
* FV surface latent heat flux
* AT inhomogeneous term of diffusion in the eq. for Theta
* AQ inhomogeneous term of diffusion in the eq. for Q
*
*
#include "consphy.cdk"
*
*
INTEGER I
*
*
******************************************************
* AUTOMATIC ARRAYS
******************************************************
*
AUTOMATIC ( PSKI , REAL , (N) )
AUTOMATIC ( SC , REAL , (N) )
AUTOMATIC ( TH , REAL , (N) )
*
******************************************************
*
*
*
DO I=1,N
*
TS(I) = 0.5*( TS(I) + TST(I) )
T2(I) = 0.5*( T2(I) + T2T(I) )
WG(I) = 0.5*( WG(I) + WGT(I) )
W2(I) = 0.5*( W2(I) + W2T(I) )
WR(I) = 0.5*( WR(I) + WRT(I) )
WS(I) = 0.5*( WS(I) + WST(I) )
ALPHAS(I) = 0.5*( ALPHAS(I) + ALPHAST(I) )
RHOS(I) = 0.5*( RHOS(I) + RHOST(I) )
*
WG(I) = MAX( WG(I) , 0.001 )
W2(I) = MAX( W2(I) , 0.001 )
*
END DO
*
*
*
* Preliminary calculations before
* the feedback on the vertical diffusion
*
DO I=1,N
SC(I) = 1. / ( SELOC(I,NK-1)-SELOC(I,NK-2) )
PSKI(I) = ( 1.E5 / PS(I) )**CAPPA
TH(I) = T(I)*PSKI(I)
END DO
*
*
*
* Feedback on the vertical diffusion
*
DO I=1,N
BM(I) = -VMOD(I)*CD(I)*( GRAV / (RGASD*TH(I)) )
FQ(I) = RHOA(I)*CD(I)*VMOD(I)*VMOD(I)
FC(I) = HFLUX(I)
FV(I) = LE(I)
AT(I,NK-1) = AT(I,NK-1)
1 + (TSFC(I)-GAMAZA(I))*BT(I)*SC(I)
1 + GRAV*FC(I)*SC(I) / (CPD*PS(I))
AQ(I,NK-1) = AQ(I,NK-1)
1 + QSFC(I)*BT(I)*SC(I)
1 + GRAV*FV(I)*SC(I) / (CHLC*PS(I))
BT(I) = 0.0
END DO
*
*
*
*
*
*
RETURN
END