copyright (C) 2001  MSC-RPN COMM  %%%MC2%%%
***s/r nacbar -- Computes alfa,ap1r,n02g,gc02
*

      subroutine nacbar (implicit) 1
      implicit none
*
      logical implicit
*
#include "consdyn_8.cdk"
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
#include "dynmem.cdk"
#include "dynpar.cdk"
#include "alfmem.cdk"
#include "dtmdtp.cdk"
#include "partopo.cdk"
*
      integer i,j,k,id,jd,iff,jf,kp1,ng
      real*8 pt5,one,two,n2g_star,aimp,c02k,s1
      real*8, dimension(:,:), allocatable :: w1,w2
      parameter(pt5=0.5d0,one=1.0d0,two=2.0d0)
*---------------------------------------------------------------
*
      n2g_star=grav_8/(cpd_8*grtstar)
*
*   for all possible grid points
*
      id =1-hx
      jd =1-hy
      iff=ldni+hx
      jf =ldnj+hy
      ng = (iff-id+1) * (jf-jd+1)
      allocate (w1(id:iff,jd:jf),w2(id:iff,jd:jf))
*      
      aimp=1.0d0
      if(.not.implicit) aimp=0.d0
*
!$omp do
      do k = 1, gnk
         if( k.eq.gnk) then
            c02k = one
         else
            c02k = c02
         endif
         do j = jd, jf
         do i = id, iff
            s1 = aimp * dble(bb0(i,j,k)) * c04
            w1(i,j)     = one + s1
            alfa(i,j,k) = s1
         end do
         end do
         call vrec (w2, w1, ng)
         do j = jd, jf
         do i = id, iff
            ap1r(i,j,k) = w2(i,j)
c            gc02(i,j,k) = c02k * grav_8 * c2r_star * w2(i,j)
            s1 = n2g_star * w2(i,j)
            n02g(i,j,k) = s1
            w1(i,j) = c03+dtp*dtp*c06*s1*w2(i,j)
         end do
         end do
         call vrec (w2, w1, ng)
         do j = jd, jf
         do i = id, iff
            nu0b(i,j,k) = w2(i,j)
         end do
         end do
      end do
!$omp enddo
*
!$omp do
      do k =  gnk, 1, -1
         if( k.eq.gnk) then
            c02k = one
         else
            c02k = c02
         endif
         kp1=min(k+1,gnk)
         do j = jd, jf
         do i = id, iff
            gc02(i,j,k) = c02k * grav_8 * c2r_star /
     $                   (one+pt5*(alfa(i,j,k)+alfa(i,j,kp1)))
         end do
         end do
      enddo
!$omp enddo
*
      deallocate (w1,w2)
*---------------------------------------------------------------
      return
      end