!-------------------------------------- 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 ainmi_tend0(pvort,pdiv,pgz,plnps,pgdpsi,lddiab) 2,7
*
***s/r ainmi_tend - Adjoint of inmi_tend.ftn. Used by INMI approach.
*
*Author : Luc Fillion - 02 May 07.
*Revision:
* Luc Fillion - May 2010 - Implement in v_11_01b.
*
* -------------------
** 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 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
integer ilen,ierr,idim
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 ztt(ni,nflev,nj)
real*8 zgz(ni,nflev,nj)
real*8 zgz1(ni,nflev,nj)
real*8 zp2d(mni_in,mnj_in)
real*8 zp(ni,nflev,nj)
real*8 zps(ni,nj)
real*8 zps0(ni,nj)
!
*
**
! write(nulout,*) 'AINMI_TEND BEGINS'
!
!*1 Adjoint of: compute tendencies
! ------------------------------
!
call zero(ni*nj,plnps)
do jj = 1,nj
do ji = 1,ni
! gps0(ji,1,jj) = gps0(ji,1,jj)+plnps(ji,jj)/(delt_tl*gpsg(ji,1,jj))
! zps0(ji,jj) = -plnps(ji,jj)/(delt_tl*gpsg(ji,1,jj))
enddo
enddo
!
do jk=1,nflev
do jj=1,nj
do ji=1,ni
zvort(ji,jk,jj) = -pvort(ji,jk,jj)/delt_tl ! vort at t0
zvort1(ji,jk,jj) = pvort(ji,jk,jj)/delt_tl ! vort at t+dt
zdiv(ji,jk,jj) = -pdiv(ji,jk,jj)/delt_tl
zdiv1(ji,jk,jj) = pdiv(ji,jk,jj)/delt_tl
zgz(ji,jk,jj) = -pgz(ji,jk,jj)/delt_tl ! gz at t0
zgz1(ji,jk,jj) = pgz(ji,jk,jj)/delt_tl ! gz at t+dt
enddo
enddo
enddo
!
!*2. Adjoint of: Compute (Vort,Div,GZ) at later time
! -----------------------------------------------
!
!*2.1 Adjoint of: compute GZ at later time
!
!
call zero(ni*nj*nflev,ztt)
!ping call att2phi_inmi(ztt,zgz1)
!
do jk=1,nflev
do jj=1,nj
do ji=1,ni
tt0(ji,jk,jj)= tt0(ji,jk,jj)+ztt(ji,jk,jj)
enddo
enddo
enddo
!
!*2.2 Adjoint of: compute vort,div at later time
!
! call aUV2zdg_c(zu0,zv0,zvort1,zdiv1)
!
!*2.3 Adjoint of: Symmetrize (U,V) (on analysis grid) coming from GEM-LAM
!
! do jk=1,nflev
! do ji=1,mni_in
! do jj=1,mnj_in
! ut0(ji,jk,jj)= zu0(ji,jk,jj)
! vt0(ji,jk,jj)= zv0(ji,jk,jj)
! enddo
! enddo
! enddo
!
!*3. Call ADJ
! --------
!
if(lddiab) then
call putdx2('L')
call getdx('L')
else
call putdx2('J')
call getdx('J')
endif
!
! do ji=1,mni_in
! do jj=1,mnj_in
! do jk=1,nflev
! ut0(ji,jk,jj) = 2.*ut0(ji,jk,jj)
! vt0(ji,jk,jj) = 4.*vt0(ji,jk,jj)
! tt0(ji,jk,jj) = 6.*tt0(ji,jk,jj)
! q0(ji,jk,jj) = 8.*q0(ji,jk,jj)
! enddo
! gps0(ji,1,jj) = 4.*gps0(ji,1,jj)
! enddo
! enddo
!!
!*4. Adjoint of: Compute (Vort,Div,GZ) at time 0
! -------------------------------------------
!
call zero(ni*nj*nflev,ztt)
!ping call att2phi_inmi(ztt,zgz)
!
! do jj=1,nj
! do ji=1,ni
! gps0(ji,1,jj) = gps0(ji,1,jj) + zps0(ji,jj)
! enddo
! enddo
!
! GZ
!
! do jk=1,nflev
! do jj=1,nj
! do ji=1,ni
! tt0(ji,jk,jj)= tt0(ji,jk,jj) + ztt(ji,jk,jj)
! enddo
! enddo
! enddo
!
! call aUV2zdg_c(zu0,zv0,zvort,zdiv)
!
!*5. Adjoint of: Prepare fields ready for TL call
! --------------------------------------------
!
! call apc2UVg_c(pgdpsi,ztt,zu1,zv1) ! Sensitivity only in PSI (not Chi) due to Divergence-Free Rossby modes.
!
return
end