!-------------------------------------- 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 LIN_DIFF_VERT1
*
#include "phy_macros_f.h"
SUBROUTINE LIN_DIFF_VERTTQ1 (TU, U, KU, GU, ALFA, BETA, S, SK, 2,2
% TAU, F, A, B, C, D, N, NK)
*
#include "impnone.cdk"
INTEGER N, NK
REAL TU(N, NK), U(N, NK), KU(N, NK), GU(N, NK)
REAL ALFA(N), BETA(N), S(N,NK), SK(N,NK), TAU, F
REAL A(N, NK), B(N, NK), C(N, NK), D(N, NK)
*
*Author
* L. Spacek (Jun 2008)
*
*Object
* to solve a TLM vertical diffusion equation by finite
* differences on thermo levels
*
*Arguments
*
* - Output -
* TU U tendency (D/DT U) due to the vertical diffusion and to
* term R
*
* - Input -
* U variable to diffuse (U,V,T,Q,E)
* KU diffusion coefficient
* GU optional countergradient term
* ALFA inhomogeneous term for the surface flux
* BETA homogeneous term for the surface flux
* S sigma coordinates of full levels
* SK sigma coordinates of diffusion coefficient levels
* TAU length of timestep
* F waiting factor for time 'N+1'
* A work space (N,NK)
* B work space (N,NK)
* C work space (N,NK)
* D work space (N,NK)
* N number of columns to process
* NK vertical dimension
*
*Notes
* D/DT U = D(U)
* D(U) = D/DS J(U)
* J(U) = KU*(D/DS U + GU)
*
**
*
INTEGER I, K
REAL SC, SCTU, ST, SB, HM, HP, HD, KUM, KUP, SCK1
EXTERNAL LIN_DIFUVD1, LIN_DIFUVD2
*
*
************************************************************************
* AUTOMATIC ARRAYS
************************************************************************
*
AUTOMATIC (VHM ,REAL ,(N,NK) )
AUTOMATIC (VHP ,REAL ,(N,NK) )
AUTOMATIC (RHD ,REAL*8 ,(N,NK) )
AUTOMATIC (RHMD ,REAL*8 ,(N,NK) )
AUTOMATIC (RHPD ,REAL*8 ,(N,NK) )
*
ST(i)=S(i,1)-0.5*(S(i,2)-S(i,1))
SB(i)=1.
*
SC = 1.0
SCTU = 0
SCK1 = 1
*
* (1) CONSTRUIRE L'OPERATEUR TRIDIAGONAL DE DIFFUSION N=(A,B,C)
* ET LE TERME CONTRE-GRADIENT (DANS D)
*
* K=1
*
HM=0
DO I=1,N
HM=SK(i,1)-ST(i)
HP=SK(i,2)-SK(i,1)
HD=S(i,2)-S(i,1)
KUM=0
KUP=0.5*(KU(I,1)+KU(I,2))
A(I,1)=KUM/(HM*HD)
C(I,1)=KUP/(HP*HD)
B(I,1)=-A(I,1)-C(I,1)
D(I,1)=(KUP*(GU(I,1)+GU(I,2))-KUM*GU(I,1))/(2*HD)
ENDDO
*
* K=2...NK-1
*
DO K=2,NK-1,1
DO I=1,N
VHM(I,K)=SK(I,K)-SK(I,K-1)
VHP(I,K)=SK(I,K+1)-SK(I,K)
HD=S(I,K+1)-S(I,K)
RHD(I,K)=HD
RHMD(I,K)=VHM(I,K)*HD
RHPD(I,K)=VHP(I,K)*HD
ENDDO
ENDDO
CALL VREC( RHD(1,2), RHD(1,2),N*(NK-2))
CALL VREC(RHMD(1,2),RHMD(1,2),N*(NK-2))
CALL VREC(RHPD(1,2),RHPD(1,2),N*(NK-2))
DO K=2,NK-1,1
DO I=1,N
KUM=0.5*(KU(I,K-1)+KU(I,K))
KUP=0.5*(KU(I,K+1)+KU(I,K))
A(I,K)=KUM*RHMD(I,K)
C(I,K)=KUP*RHPD(I,K)
B(I,K)=-A(I,K)-C(I,K)
D(I,K)=.5*(KUP*(GU(I,K)+GU(I,K+1))
% -KUM*(GU(I,K-1)+GU(I,K)))*RHD(I,K)
ENDDO
ENDDO
*
* K=NK
*
HP=0
DO I=1,N
HM=SK(i,NK)-SK(i,NK-1)
HD=SB(i)-S(i,NK)
KUM=0.5*(KU(I,NK)+KU(I,NK-1))
KUP=0
A(I,NK)=KUM/(HM*HD)
C(I,NK)=0
B(I,NK)=-A(I,NK)-C(I,NK)
D(I,NK)=(0-KUM*(GU(I,NK)+GU(I,NK-1)))/(2*HD)
ENDDO
*
*
* (2) CALCULER LE COTE DROIT D=TAU*(SC*N(U)+R+D/DS(KU*GU))
*
CALL LIN_DIFUVD1 (D, SC, A, B, C, U, D, N, NK)
DO K=1,NK
DO I=1,N
D(I,K) = TAU*D(I,K)
ENDDO
ENDDO
*
* (3) CALCULER OPERATEUR DU COTE GAUCHE
*
DO K=1,NK
DO I=1,N
A(I,K)= -SC*TAU*A(I,K)
B(I,K)=1.-SC*TAU*B(I,K)
C(I,K)= -SC*TAU*C(I,K)
ENDDO
ENDDO
*
* (4) AJOUTER TERME DE FLUX DE SURFACE POUR TYPE='U'/'UT'
*
DO I=1,N
HD=SB(I)-S(I,NK)
B(I,NK)=B(I,NK)-F*TAU*BETA(I)/HD
D(I,NK)=D(I,NK)+(ALFA(I)+BETA(I)*U(I,NK))*TAU/HD
ENDDO
*
*
* (5) RESOUDRE SYSTEME TRIDIAGONAL [A,B,C] X = D. METTRE X DANS TU.
*
CALL LIN_DIFUVD2 (TU, A, B, C, D, D, N, NK)
*
* (6) OBTENIR TENDANCE
*
DO K=1,NK
DO I=1,N
TU(I,K) = TU(I,K)/TAU
ENDDO
ENDDO
*
RETURN
END