!-------------------------------------- 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  pre_diago -  Diagonal preconditioning  
*
#include "model_macros_f.h"

      subroutine pre_diago( Sol, Rhs, Minx, Maxx, Miny, Maxy, 1
     $                      nil,njl, minx1, maxx1, minx2, maxx2, Nk )
      implicit none
*
      integer Minx, Maxx, Miny, Maxy, nil, njl,
     $        minx1, maxx1, minx2, maxx2,Nk
      real*8  Rhs(Minx:Maxx,Miny:Maxy,Nk),
     +        Sol(Minx:Maxx,Miny:Maxy,Nk)
*
* author    Abdessamad Qaddouri -  December 2006
*
*revision
* v3_30 - Qaddouri A.       - initial version
*
#include "glb_ld.cdk"
#include "opr.cdk"
#include "cstv.cdk"
#include "sol.cdk"
*
      integer j,i,k,ii,jj
      real*8  stencil1,cst,di_8,wwk(nk)
*
*     ---------------------------------------------------------------
*
      do k=1, NK
         wwk(k)= (Cstv_hco1_8+Cstv_hco0_8*Opr_zeval_8(k))
      enddo                                                 
*
      do k = 1,Nk 
         do j=1+sol_pil_s, njl-sol_pil_n
            jj=j+l_j0-1
            di_8= Opr_opsyp0_8(G_nj+jj) / cos( G_yg_8 (jj) )**2
            do i=1+sol_pil_w, nil-sol_pil_e
               ii=i+l_i0-1
               cst= wwk(k)
               stencil1=cst*Opr_opsxp0_8(G_ni+ii)*
     *           Opr_opsyp0_8(G_nj+jj) +Opr_opsxp2_8(G_ni+ii)*di_8+
     *           Opr_opsxp0_8(G_ni+ii)*Opr_opsyp2_8(G_nj+jj)
*
               Rhs(i,j,k) =sol(i,j,k)/stencil1
            enddo
         enddo
      enddo
*
*     ---------------------------------------------------------------
*
      return
      end