!-------------------------------------- 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/p - readlam
#include "model_macros_f.h"
*

      subroutine readlam(f,DIST_DIM,nk,i0,in,j0,jn,k0,kn,unit),1
#include "impnone.cdk"
#include "glb_ld.cdk"
#include "ptopo.cdk"
      integer DIST_DIM,nk,unit
      real f(DIST_SHAPE,nk)
      integer i,j,k,i0,in,j0,jn,k0,kn,err
      real flam
      pointer (p_flam,flam(in-i0+1,jn-j0+1,kn-k0+1))
      real wk1
      pointer (p_wk1, wk1(G_ni,G_nj,*))

      if (Ptopo_myproc.eq.0) then
         call hpalloc (p_wk1, G_ni*G_nj*nk, err, 1)
         call hpalloc (p_flam,(in-i0+1)*(jn-j0+1)*(kn-k0+1),err,1)
         read (unit) flam
         do k=k0,kn
         do j=j0,jn
         do i=i0,in
            wk1(i,j,k) = flam(i-i0+1,j-j0+1,k-k0+1)
         enddo
         enddo
         enddo
      endif
      call glbdist(wk1,G_ni,G_nj,f,LDIST_DIM,nk,G_halox,G_haloy)
      if (Ptopo_myproc.eq.0) then
      call hpdeallc (p_wk1,err,1)
      call hpdeallc (p_flam,err,1)
      endif

      return
      end