!-------------------------------------- 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  mat_vec -   matrix-vector: Helmhotz*vector  
*                 
*
#include "model_macros_f.h"

      subroutine  mat_vecs ( Sol, Rhs, Minx, Maxx, Miny, Maxy,nil,  1
     $                       njl,minx1, maxx1, minx2, maxx2,Nk,fdg1 )   
      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),
     +       fdg1(minx1:maxx1, minx2:maxx2, 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,halox,haloy
      real*8  stencil1,stencil2,stencil3,stencil4,stencil5,cst,di_8
      real*8, dimension (Nk+1) :: wwk
*
*     ---------------------------------------------------------------
*
      do k = 1, nk
         fdg1(:,:,k) = .0d0
         do j=1+sol_pil_s, njl-sol_pil_n
         do i=1+sol_pil_w, nil-sol_pil_e
            fdg1(i,j,k)=sol(i,j,k)
         enddo
         enddo
      enddo
*
      halox=1
      haloy=halox
*
!$omp single
      call rpn_comm_xch_halon (fdg1,minx1,maxx1,minx2,maxx2,nil,njl,
     $                   Nk,halox,haloy,G_periodx,G_periody,nil,0,2)
!$omp end single
*
      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)
               stencil2= Opr_opsxp2_8(ii)*di_8
               stencil3= Opr_opsxp2_8(2*G_ni+ii)*di_8
               stencil4= Opr_opsxp0_8(G_ni+ii)*Opr_opsyp2_8(jj)
               stencil5= Opr_opsxp0_8(G_ni+ii)*Opr_opsyp2_8(2*G_nj+jj)
*
               Rhs(i,j,k) =stencil1*fdg1(i  ,j  ,k) + 
     $                     stencil2*fdg1(i-1,j  ,k) +
     $                     stencil5*fdg1(i  ,j+1,k) + 
     $                     stencil4*fdg1(i  ,j-1,k) +
     $                     stencil3*fdg1(i+1,j  ,k)
            enddo
         enddo
      enddo
*
*     ---------------------------------------------------------------
*
      return
      end