!-------------------------------------- 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/r difuvt
*
subroutine difuvt(tu, u, ku, s, tau, a, b, c, d, n, nu, nk) 3,2
*
implicit none
integer n, nu, nk
real tu(nu, nk), u(nu, nk), ku(nu, nk)
real s(nu,nk), tau
real a(n, nk), b(n, nk), c(n, nk), d(n, nk)
*
*Author S. Gravel (from difuvdfj)
*
*revision
* v3_20 - Gravel S. - initial MPI version (from difuvdfj:GEM)
*
*Object
* to solve implicitly a vertical diffusion equation by finite
* differences
*
*Arguments
*
* - Output -
* tu U tendency (D/DT U) due to the vertical diffusion
*
* - Input -
* U variable to diffuse (U,V,T,Q,E)
* KU diffusion coefficient
* S sigma coordinates of full levels
* TAU length of timestep
* A work space (N,NK)
* B work space (N,NK)
* C work space (N,NK)
* D work space (N,NK)
* NU 1st dimension of TU and U
* NK vertical dimension
*
*Notes
*
INTEGER I, K
REAL HM, HP, HD
EXTERNAL DIFUVD1, DIFUVD2
*
real VHM(N,NK), VHP(N,NK)
real*8 RHD(N,NK), RHMD(N,NK), RHPD(N,NK)
*
*
* (1) build tridiagonal diffusion operator N=(A,B,C)
*
*
* K=1
*
HM=0
DO 10 I=1,N
HP=S(i,2)-S(i,1)
HD=0.5*(S(i,1)+S(i,2))-S(i,1)
A(I,1)=0.0
B(I,1)=-KU(I,1)/(HP*HD)
C(I,1)=-B(I,1)
10 D(I,1)=0.0
*
* K=2...NK-1
*
DO K=2,NK-1,1
DO I=1,N
C THE FOLLOWING LHS ARE IN REAL
VHM(I,K)=S(I,K)-S(I,K-1)
VHP(I,K)=S(I,K+1)-S(I,K)
HD=0.5*(VHM(I,K)+VHP(I,K))
C THE FOLLOWING LHS ARE IN REAL*8
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
A(I,K)=KU(I,K-1)*RHMD(I,K)
B(I,K)=-(KU(I,K-1)/VHM(I,K) +KU(I,K)/VHP(I,K))*RHD(I,K)
C(I,K)=KU(I,K)*RHPD(I,K)
D(I,K)=0.0
ENDDO
ENDDO
*
* K=NK
*
HP=0
DO 12 I=1,N
HM=S(i,NK)-S(i,NK-1)
HD=0.5*(1.0+S(i,NK))-0.5*(S(i,NK-1)+S(i,NK))
A(I,NK)=KU(I,NK-1)/(HM*HD)
B(I,NK)=-(KU(I,NK-1)/HM + 0)/HD
C(I,NK)=0.0
12 D(I,NK)=0.0
*
*
* (2) calculate r.h.s. D=TAU*N(U)
*
CALL DIFUVD1
(D, 1., A, B, C, U, D, N, NU, NK)
DO 20 K=1,NK
DO 20 I=1,N
20 D(I,K)=TAU*D(I,K)
*
* (3) build l.h.s operator
*
DO 30 K=1,NK
DO 30 I=1,N
A(I,K)= -TAU*A(I,K)
B(I,K)=1-TAU*B(I,K)
30 C(I,K)= -TAU*C(I,K)
*
*
* (5) solve tridiagonal system [A,B,C] X = D. solution X is in TU.
*
CALL DIFUVD2 (TU, A, B, C, D, D, NU, N, NK)
*
* (6) tendancy
*
DO 60 K=1,NK
DO 60 I=1,N
60 TU(I,K)=TU(I,K)/TAU
*
RETURN
END