copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
***s/r les_3d
*

      subroutine les_3d 1,7
      implicit none
*
#include "nesting.cdk"
#include "dynmem.cdk"
#include "tracers.cdk"
#include "nestpnt.cdk"
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
#include "dynpar.cdk"
#include "consdyn_8.cdk"
#include "levels.cdk"
#include "partopo.cdk"
#include "les.cdk"
#include "topo.cdk"
#include "refer.cdk"
#include "h_geop.cdk"
#include "bcsdim.cdk"
#include "bcsmem.cdk"
*    
      integer i,j,k,n,dim,kc,kp1,km1,
     $        id,indn,indw,inde,ofn,ofw,ofe
      real s,d
      pointer (pas1 ,s(*)), (pad1 ,d(*))
*
*---------------------------------------------------------------------
*
* define the initial conditions for the winds
*
      uup = les_flo
      vvp = 0.
*
* define the initial conditions for temperature and pressure
*
      bbp = 0.
      ppp = 0.
*
* Initialize Moisture and Vertical motion to zero and tracers to 1
*
      hup = 0.
      wwp = 0.
      trp = 1.
*
      dim = ndynvar*dim3d+dim2d
      pas1 = pappp
      pad1 = papp0
      do i=1,dim
         d(i) = s(i)
      end do
*
      ofn  = (bcs_in-bcs_is)/gnk
      ofw  = (bcs_iw-bcs_in)/gnk
      ofe  = (bcs_ie-bcs_iw)/gnk
      indn = bcs_in + ofn
      indw = bcs_iw + ofn + ofw
      inde = bcs_ie + ofn + ofw + ofe
      call trnes (uup,bcs_uu(bcs_is),bcs_uu(bcs_in),bcs_uu(bcs_iw),
     $                          bcs_uu(bcs_ie),minx,maxx,miny,maxy,
     $         minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
      call trnes (vvp,bcs_vv(bcs_is),bcs_vv(bcs_in),bcs_vv(bcs_iw),
     $                          bcs_vv(bcs_ie),minx,maxx,miny,maxy,
     $         minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
      call trnes (wwp,bcs_ww(bcs_is),bcs_ww(bcs_in),bcs_ww(bcs_iw),
     $                          bcs_ww(bcs_ie),minx,maxx,miny,maxy,
     $         minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
      call trnes (bbp,bcs_bb(bcs_is),bcs_bb(bcs_in),bcs_bb(bcs_iw),
     $                          bcs_bb(bcs_ie),minx,maxx,miny,maxy,
     $         minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
      call trnes (ppp,bcs_pp(bcs_is),bcs_pp(indn)  ,bcs_pp(indw)  ,
     $                          bcs_pp(inde)  ,minx,maxx,miny,maxy,
     $       minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk+1)
      call trnes (hup,bcs_hu(bcs_is),bcs_hu(bcs_in),bcs_hu(bcs_iw),
     $                          bcs_hu(bcs_ie),minx,maxx,miny,maxy,
     $         minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
      do n = 1, ntr
         id = (n-1)*bcs_sz+1
         call trnes (trp(1-hx,1-hy,1,n),bcs_tr(id),bcs_tr(id+bcs_in-1),
     $     bcs_tr(id+bcs_iw-1),bcs_tr(id+bcs_ie-1),minx,maxx,miny,maxy,
     $             minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk)
      end do
      if (ctebcs) then
         do i=1,(ntr+6)*bcs_sz+bcs_sz/gnk
            bcs_ppa(i) = bcs_pp(i)
         end do
      endif
*
      if (gnpilver.gt.0) then
      do k=1,gnk
      do j=1-hy,ldnj+hy
      do i=1-hx,ldni+hx
         ppntt(i,j,k) = ppp(i,j,k)
         uuntt(i,j,k) = uup(i,j,k)
         vvntt(i,j,k) = vvp(i,j,k)
         wwntt(i,j,k) = wwp(i,j,k)
         bbntt(i,j,k) = bbp(i,j,k)
         huntt(i,j,k) = hup(i,j,k)
      end do
      end do
      end do
      do n = 1, ntr
         do k=1,gnk
         do j=1-hy,ldnj+hy
         do i=1-hx,ldni+hx
            trntt(i,j,k,n) = trp(i,j,k,n)
         end do
         end do
         end do
      end do
      do j=1-hy,ldnj+hy
      do i=1-hx,ldni+hx
         ppntt(i,j,0) = ppp(i,j,0)
      end do
      end do
*
      if (ctebcs) then
         do k=1,gnk
         do j=1-hy,ldnj+hy
         do i=1-hx,ldni+hx
            ppnta(i,j,k) = ppp(i,j,k)
            uunta(i,j,k) = uup(i,j,k)
            vvnta(i,j,k) = vvp(i,j,k)
            wwnta(i,j,k) = wwp(i,j,k)
            bbnta(i,j,k) = bbp(i,j,k)
            hunta(i,j,k) = hup(i,j,k)
         end do
         end do
         do n=1,ntr
            do j=1-hy,ldnj+hy
            do i=1-hx,ldni+hx
               trnta(i,j,k,n) = trp(i,j,k,n)
            end do
            end do
         end do
         end do
         do j=1-hy,ldnj+hy
         do i=1-hx,ldni+hx
            ppnta(i,j,0) = ppp(i,j,0)
         end do
         end do
      endif
      endif
*     
      if (myproc.eq.0) then
         write (6,602)
      endif
*
 602  format (/'INITIALIZATION OF LES PROBLEM COMPLETED')
*---------------------------------------------------------------------
      return
      end