!-------------------------------------- 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 --------------------------------------
!
C
C X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X
C
subroutine inmi_tend0(pvort,pdiv,pgz,plnps,pgdpsi,ldwrite,lddiab) 2,6
*
***s/r inmi_tend0 - Computes time-tendencies required by INMI scheme.
* i.e.: d(Vort,Div,T,lnps)/dt
* ref: Temperton, C., M. Roch, 1991: Implicit Normal Mode Initialization
* for an Operational Regional Model, MWR 119, 667-677.
* See p. 670. before eqn. (3.1).
*
*Author : Luc Fillion - 25 Apr. 2007.
*Revision:
* Luc Fillion - ARMA/EC - May 2010 - Implemented in v_11_01b of 3dvar.
*
* -------------------
** Purpose: Used for LA-XD-Var analysis
*
*Arguments
*
implicit none
#include "taglam4d.cdk"
#include "comdim.cdk"
#include "comgrd_param.cdk"
#include "comcst.cdk"
#include "comcva.cdk"
#include "comgd0.cdk"
#include "comgd1.cdk"
#include "compdg.cdk"
#include "comlun.cdk"
#include "comcorr.cdk"
#include "comgdpar.cdk"
#include "comin.cdk"
#include "comode.cdk"
!
logical ldwrite,lddiab
real*8 pvort(ni,nflev,nj)
real*8 pdiv(ni,nflev,nj)
real*8 pgz(ni,nflev,nj)
real*8 plnps(ni,nj)
real*8 pgdpsi(ni,nflev,nj)
!
character*3 clvar
character*8 clletiket
logical llout
integer ji,jj,jk,nip1,njp1,jk1,jk2,ilev,ifois
integer ilen,ierr
integer idum1,idum2,idum3,idum4
!
real*8 zmin,zmax,zcscl
real*8 zvort(ni,nflev,nj)
real*8 zdiv(ni,nflev,nj)
real*8 zvort1(ni,nflev,nj)
real*8 zdiv1(ni,nflev,nj)
real*8 ztt0(ni,nflev,nj)
real*8 ztt(ni,nflev,nj)
real*8 zgz(ni,nflev,nj)
real*8 zgz1(ni,nflev,nj)
real*8 zp(ni,nflev,nj)
real*8 zps(ni,nj)
real*8 zps0(ni,nj)
!
*
**
! write(nulout,*) 'INMI_TEND BEGINS'
!
ilev = nflev/2
!
!*1. Prepare fields ready for TL call
! --------------------------------
!
zp(:,:,:) = 0.0
!
! call pc2UVg_c(zu0,zv0,pgdpsi,zp) ! Divergence-free Rossby modes
!
! do jk=1,nflev
! do ji=0,ni+1
! do jj=0,nj+1
! ut0(ji,jk,jj) = zu0(ji,jk,jj)
! vt0(ji,jk,jj) = zv0(ji,jk,jj)
! enddo
! enddo
! enddo
!
!*2. Compute (Vort,Div,GZ) at time 0
! -------------------------------
!
! call UV2zdg_c(zvort,zdiv,zu0,zv0)
!
do jk=1,nflev
do jj=1,nj
do ji=1,ni
ztt0(ji,jk,jj) = tt0(ji,jk,jj)
enddo
enddo
enddo
!
! GZ
do ji=1,ni
do jj=1,nj
zps0(ji,jj) = gps0(ji,1,jj)
enddo
enddo
!
call ltt2phi_inmi(zgz,ztt0)
!
!*3. Call TLM
! --------
!
if(lddiab) then
call putdx2('K')
call getdx('K')
else
call putdx2('I')
call getdx('I')
endif
!
!*4. Compute (Vort,Div,GZ) at later time
! -----------------------------------
!
!*4.2 compute vort,div
!
! call UV2zdg_c(zvort1,zdiv1,zu0,zv0)
!
!*4.3 compute GZ
!
do jk=1,nflev
do jj=1,nj
do ji=1,ni
ztt(ji,jk,jj) = tt0(ji,jk,jj)
enddo
enddo
enddo
!
call ltt2phi_inmi(zgz1,ztt)
!
!*4.4 compute tendencies
!
write(nulout,*) 'inmi_tend: delt_tl = ',delt_tl
do jk=1,nflev
do jj=1,nj
do ji=1,ni
pvort(ji,jk,jj) = (zvort1(ji,jk,jj)-zvort(ji,jk,jj))/delt_tl
pdiv(ji,jk,jj) = (zdiv1(ji,jk,jj)-zdiv(ji,jk,jj))/delt_tl
pgz(ji,jk,jj) = (zgz1(ji,jk,jj)-zgz(ji,jk,jj))/delt_tl
enddo
enddo
enddo
!
plnps(:,:) = 0.0
do jj = mjobsbufs,nj-mjobsbufn
do ji = miobsbufw,ni-miobsbufe
plnps(ji,jj) = (gps0(ji,1,jj)-zps0(ji,jj))
& /(delt_tl*gpsg(ji,1,jj))
enddo
enddo
!
if(ldwrite.or.lminend) then
clletiket='INMITEND'
clvar = 'DD '
do jk=1,nflev
do jj=1,nj
do ji=1,ni
zp(ji,jk,jj)=pdiv(ji,jk,jj)
enddo
enddo
enddo
! call write_fld(zp,clvar,clletiket,nflev)
!
clletiket='INMITEND'
clvar = 'QQ '
do jk=1,nflev
do jj=1,nj
do ji=1,ni
zp(ji,jk,jj)=pvort(ji,jk,jj)
enddo
enddo
enddo
! call write_fld(zp,clvar,clletiket,nflev)
!
clletiket='INMITEND'
clvar = 'GZ '
do jk=1,nflev
do jj=1,nj
do ji=1,ni
zp(ji,jk,jj)=pgz(ji,jk,jj)
enddo
enddo
enddo
! call write_fld(zp,clvar,clletiket,nflev)
!
clletiket='INMITEND'
clvar = 'P0 '
do jj=1,nj
do ji=1,ni
zps(ji,jj)=plnps(ji,jj)
enddo
enddo
! call write_fld(zps,clvar,clletiket,1)
endif
!
return
end