!-------------------------------------- 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_jacobi -      Jcobi additive-Schwarz preconditioning
*

      subroutine pre_jacobi ( Sol,Rhs,evec_local,Fdg,Ni,Nj,Nk,ai,bi,ci ) 2
      implicit none
*
      integer Ni,Nj,Nk
      real*8 Rhs(Ni,Nj,Nk),Sol(Ni,Nj,Nk),Fdg(Ni,Nj,Nk)
      real*8  ai(Ni,Nj,Nk), bi(Ni,Nj,Nk), ci(Ni,Nj,Nk)
      real*8 evec_local(Ni,Ni) 
*
*author
*       Abdessamad Qaddouri - December  2006
*
*revision
* v3_30 - Qaddouri A.       - initial version
*
      integer i,j,k,jr
*
*     ---------------------------------------------------------------
*
      do k=1,Nk
         call dgemm('T','N',Ni,Nj,Ni,1.0d0,evec_local,Ni,
     $                 Rhs(1,1,k),Ni,0.0d0,Fdg(1,1,k),Ni)
      enddo
*
      Do k=1,Nk
         Do j =2, Nj
            jr =  j - 1
            Do i=1,Ni
               Fdg(i,j,k) = Fdg(i,j,k) - ai(i,j,k)*Fdg(i,jr,k)
            Enddo
         Enddo
         j = Nj
         Do i=1,Ni
            Fdg(i,j,k) = Fdg(i,j,k)/bi(i,j,k)
         Enddo
         Do j = Nj-1, 1, -1
            jr =  j + 1
            Do i=1 , Ni
            Fdg(i,j,k)=(Fdg(i,j,k)-ci(i,j,k)*Fdg(i,jr,k))/bi(i,j,k)
            Enddo
         Enddo
      Enddo
*
      Do k=1,Nk
         call dgemm('N','N',Ni,Nj,Ni,1.0d0,evec_local,Ni,
     $                  Fdg(1,1,k),Ni,0.d0,Sol(1,1,k),Ni)
      Enddo
*
*     ---------------------------------------------------------------
*
      return
      end