      SUBROUTINE PUV_PREP_COV(mv_begin,mv_end,NumMinVols,
     &             nobs,LEVLINDX,nrep,data,
     &             FCERR,glatup,glonup,nh,volcentre_x,volcentre_y,
     &             gplat,gplon,plat,plon,pstd,gstd,pdel,pkx,wlat,
     &             wlon,wstd,udel,vdel,wkx,glat,glon,np,nw)

c...................................................................
! PUV_PREP_COV gathers data indexed by LEVLINDX into arrays indexed
! by mini-volume label, which will be shipped to local PUVCOV routines.
c..................................................................c
!                                                                  !
! NASA Goddard Space Flight Center       Data Assimilation Office  !
!                                                                  !
! Goddard Earth Observing System                                   !
! Data Analysis System - Version 1.3.2                             !
! September, 1993                                                  !
!                                                                  !
c------------------------------------------------------------------c
C**********************************************************************
C  Data parallel implementation (CM Fortran) : M. Makivic (NPAC)      *
C  Date:       4/94                                                   *
C**********************************************************************

      include 'params.h'
      PARAMETER (maxdat = 150)
      include 'processors.h'

      integer mv_begin, mv_end

      real,dimension(NumMinVols,mxreps):: LEVLINDX,typemm
!hpf$ distribute typemm(block,*) onto PROC_ARRAY_1D
      integer,dimension(NumMinVols)::nrep
      real,dimension(im,jnp):: fcerr     
      real,dimension(nobs,NRECORDS):: data
      integer,dimension(NumMinVols,700):: gplat,gplon
      real,dimension(NumMinVols,700):: plat,plon,pstd,
     &     gstd,pdel,pkx,wlat,wlon,wstd,wkx,
     &     glat,glon,udel,vdel
      integer,dimension(NumMinVols)::np,nw

      COMMON /SFCDRAG/ DRAG(imr,jmr+1),IWATER(13104)
!hpf$ distribute drag(*,block) onto PROC_ARRAY_1D
!hpf$ distribute iwater(block) onto PROC_ARRAY_1D


!hpf$ distribute gplat(block,*) onto PROC_ARRAY_1D
!hpf$ distribute gplon(block,*) onto PROC_ARRAY_1D
!hpf$ distribute data(block,*) onto PROC_ARRAY_1D
!hpf$ distribute fcerr(*,block) onto PROC_ARRAY_1D
!hpf$ distribute nrep(block) onto PROC_ARRAY_1D
!hpf$ distribute levlindx(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     udel(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     vdel(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     plat(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     plon(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     pstd(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     gstd(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     pdel(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     pkx(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     wlat(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     wlon(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     wstd(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     wkx(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     glat(block,*) onto PROC_ARRAY_1D
!hpf$ distribute     glon(block,*) onto PROC_ARRAY_1D
!hpf$ distribute np(block) onto PROC_ARRAY_1D
!hpf$ distribute nw(block) onto PROC_ARRAY_1D

      real,dimension(NumMinVols,700)::plstmm,wlstmm
      integer,dimension(NumMinVols,150)::flag,icount,valid
      integer,dimension(NumMinVols,150)::mmcount1
!hpf$ distribute plstmm(block,*) onto PROC_ARRAY_1D
!hpf$ align with plstmm:: wlstmm
!hpf$ distribute flag(block,*) onto PROC_ARRAY_1D
!hpf$ align with flag::icount,valid,mmcount1

      integer,dimension(NumMinVols):: index
      real,dimension(NumMinVols):: levind
      integer,dimension(NumMinVols)::nhmask,kxx,iigpx,iigpy
      integer,dimension(NumMinVols):: nhgp,nh_count
      real,dimension(NumMinVols):: glatx,glonx
      LOGICAL,dimension(NumMinVols):: WATER
!hpf$ distribute index(block) onto PROC_ARRAY_1D
!hpf$ align with index:: levind,nhmask,kxx,iigpx,iigpy
!hpf$ align with index:: nhgp,nh_count
!hpf$ align with index:: glatx,glonx,water

      parameter (zero=0.0,one=1.0,two=2.0,onept1=1.10)
      parameter (ninety=90.0,one80=180.0,tenth=0.10,pt05=0.05)
      parameter (tenm4=0.0001)

      real,dimension(13104):: volcentre_x,volcentre_y
      integer,dimension(13104):: nh
      real,dimension(13104):: glatup,glonup
!hpf$ distribute glatup(block) onto PROC_ARRAY_1D
!hpf$ distribute glonup(block) onto PROC_ARRAY_1D
!hpf$ distribute nh(block) onto PROC_ARRAY_1D
!hpf$ distribute volcentre_x(block) onto PROC_ARRAY_1D
!hpf$ distribute volcentre_y(block) onto PROC_ARRAY_1D

 
      character*60 message
      
      COMMON /GRIDXX/   IM, JNP, MLEV

      logical first
      data first/.true./

      message(1:60) = ' '
 

      if(mv_end.ne.(mv_begin+NumMinVols-1)) then
             print *, 'Mini Volume indices messed up!'
             stop
      end if
      CALL GETCONI('MAXREP  ',MAXREP)
      if(MAXREP*3.GT.MAXDAT) then
          message = ' PUV_PREP_COV: Value of MAXREP exceeds MAXDAT.'
          call flash( 5,message,1 )
      end if
 
      call getconh('DLAT    ',dlat)
      call getconh('DLON    ',dlon)

      nhgp=nh(mv_begin:mv_end)
      max_nhgp=maxval(nhgp)
      max_nhgp2=maxval(nhgp/2)
 
!  Locate grid points within a volume.

      nh_count(:) = 0
      glatx=0
      glonx=0
      glon=0
      glat=0
      gstd=0
      gplat=0
      gplon=0

      do j = 1,2
       do i = 1,max_nhgp2

         print *, 'within the lat-lon loop'
         where(i.le.nhgp/2)
           nhmask=1
         else where
           nhmask=0
         end where

         forall(igp=1:NumMinVols,nhmask(igp).eq.1)
     &     nh_count(igp) = nh_count(igp) + 1

         glatx(:) = glatup(mv_begin:mv_end) + ( j-1 )*dlat
         where ( glatx .gt. 90. ) glatx = 90.
         forall(igp=1:NumMinVols,nhmask(igp).eq.1)
     &     glat( igp, nh_count(igp) ) = glatx(igp)

         glonx(:) = glonup(mv_begin:mv_end ) + ( i-1 )*dlon
         forall(igp=1:NumMinVols,nhmask(igp).eq.1)
     &     glon( igp,nh_count(igp) ) = glonx(igp)

         print *, 'before iigpx'
         iigpx=(GLATX+NINETY)/DLAT + ONEPT1
         iigpy=(glonx+one80)/dlon + onept1
         print *, 'after iigpy'

         forall(igp=1:NumMinVols,nhmask(igp).eq.1)
     &     gplat(igp,nh_count(igp)) = iigpx(igp)
         forall(igp=1:NumMinVols,nhmask(igp).eq.1)
     &     gplon(igp,nh_count(igp))=  iigpy(igp)

         forall(igp=1:NumMinVols,nhmask(igp).eq.1)
     &     gstd(igp,nh_count(igp))= fcerr(iigpx(igp),iigpy(igp))
     

       end do   !        <-- End looping over latitudes.
      end do      !        <-- End looping over longitudes.

                                                                                
 
C  MAKE LISTS OF PRESSURE AND WIND DATA
C  ------------------------------------
 
 
c      print *, 'ready to gather'
c      print *, NumMinVols,nobs,mxreps
c      print *, 'DATA(:,ind_type)'
c      print *, DATA(:,ind_type)
c      print *, 'LEVLINDEX'
c      print *, LEVLINDEX
c      print *, 'TYPEMM'
c      print *, TYPEMM
c      print *, 'NREP'
c      print *, NREP
      CALL MMGATHER(NumMinVols,nobs,mxreps,
     &              DATA(:,ind_type),LEVLINDX,TYPEMM,NREP)
      max_nrep=maxval(nrep)
 
      valid=0
      forall(igp=1:NumMinVols,j=1:mxreps,j.le.nrep(igp))
     &   valid(igp,j)=1

      where(valid.eq.1.and.TYPEMM .NE. TWO) 
             flag=1
      end where
      print *, 'setting flag'
      where(valid.eq.1.and.(.not.(TYPEMM .NE. TWO)))
             flag=0
      end where
      where(valid.ne.1)
          flag=0
      end where

      icount=0
      icount(:,1)=flag(:,1)
      do ipt=2,max_nrep
        icount(:,ipt)=icount(:,ipt-1)+flag(:,ipt)
      end do
      do ipt=1,max_nrep
        icount(:,ipt)=icount(:,ipt)*flag(:,ipt)
      end do

      print *, 'done with icount'
      plstmm=0.
c      do ipt=1,max_nrep
c       index(:NumMinVols)=icount(:NumMinVols,ipt)
c       levind(:NumMinVols)=int(levlindx(:NumMinVols,ipt))
c       forall(igp=1:NumMinVols,index(igp).ne.0)
c     &      plstmm(igp,index(igp))=levind(igp)
c      end do

      print *, 'Damn loop!!!!!!'
      do ipt=1,max_nrep
       do igp=1,NumMinVols
        if(icount(igp,ipt).ne.0) then
c            print *, igp,ipt,icount(igp,ipt),levlindx(igp,ipt)
            plstmm(igp,icount(igp,ipt))=levlindx(igp,ipt)
        end if
       enddo
      end do

      print *, 'done with plstmm'
      np(:)=maxval(icount(:,:),dim=2)
      print *, 'done with np'

      where(valid.eq.1.and.TYPEMM .NE. ONE)
             flag=1
      else where
             flag=0
      end where
      print *, 'finished pressure list'

      icount=0
      wlstmm=0.
      
c      forall(ipt=1:max_nrep)
c     &   icount(:,ipt)=sum(flag(:,1:ipt),dim=2)*flag(:,ipt)
c      index=0
c      do ipt=1,max_nrep
c        do igp=1,NumMinVols
c           index(igp)=icount(igp,ipt)
c           if(index(igp).ne.0) then
c              wlst(igp,index(igp))=levlindx(igp,ipt)
c           endif
c        enddo
c      end do

      icount=0
      icount(:,1)=flag(:,1)
      do ipt=2,max_nrep
        icount(:,ipt)=icount(:,ipt-1)+flag(:,ipt)
      end do
      do ipt=1,max_nrep
        icount(:,ipt)=icount(:,ipt)*flag(:,ipt)
      end do

c      forall(igp=1:NumMinVols,ipt=1:max_nrep)
c     & mmcount1(igp,ipt)=sum(flag(igp,1:ipt),dim=2)*flag(igp,ipt)
c      forall(igp=1:NumMinVols,ipt=1:max_nrep,mmcount1(igp,ipt).ne.0)
c     &      wlstmm(igp,mmcount1(igp,ipt))=levlindx(igp,ipt)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      Compiler bug here!!!!
c      It cannot compile correctly this piece of code
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      forall(ipt=1:max_nrep)
c     &   icount(:,ipt)=sum(flag(:,1:ipt),dim=2)*flag(:,ipt)
c      forall(igp=1:NumMinVols,ipt=1:max_nrep,icount(igp,ipt).ne.0)
c     &      wlst(igp,icount(igp,ipt))=levlindx(igp,ipt)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      print *, 'Damn wind loop!!!!!!'
      do ipt=1,max_nrep
       do igp=1,NumMinVols
        if(icount(igp,ipt).ne.0) then
            wlstmm(igp,icount(igp,ipt))=levlindx(igp,ipt)
        end if
       enddo
      end do

 
      nw(:)=maxval(icount(:,:),dim=2)

      print *, 'finished wind list'
C.......................................................
C
C     IF THE MINI-VOLUME IS NOT A WATER POINT
C     THEN ONLY PERFORM PRESSURE ANALYSIS
C
C.......................................................
      kxx (:)  = (gplat(:,1) - 1)*IM + gplon(:,1)
      WATER(:) = IWATER(KXX).EQ.1
      WHERE(.NOT.WATER(:)) NW(:) = 0
 
 
      print *, 'finished water'
C  GATHER STUFF FOR PRESSURE-PRESSURE COVARIANCE
C  ---------------------------------------------
c   Note the ordering of 1st data gather then model copy
c   The reason is that target arrays are initialized to 1e+16
c   in mmgather for debugging purposes
cccccccccccccccccccccccccccccccccccccccccccccccccccccc

      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_lat),PLSTMM,PLAT,NP)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_lon),PLSTMM,PLON,NP)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_fcer),PLSTMM,PSTD,NP)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_slp),PLSTMM,PDEL,NP)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_kx ),PLSTMM,PKX ,NP)

      print *, 'finished final pressure gathers'
       forall(igp=1:NumMinVols)
     &   PLAT(igp,NP(igp)+1:NP(igp)+max_nhgp) = GLAT(igp,1:max_nhgp)
       forall(igp=1:NumMinVols)
     &   PLON(igp,NP(igp)+1:NP(igp)+max_nhgp) = GLON(igp,1:max_nhgp)
       forall(igp=1:NumMinVols)
     &   PSTD(igp,NP(igp)+1:NP(igp)+max_nhgp) = GSTD(igp,1:max_nhgp)
C  GATHER STUFF FOR COVARIANCES WITH WIND TERMS
C  --------------------------------------------
 
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_lat),WLSTMM,WLAT,NW)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_lon),WLSTMM,WLON,NW)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_fcer),WLSTMM,WSTD,NW)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_uwnd),WLSTMM,UDEL,NW)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_vwnd),WLSTMM,VDEL,NW)
      CALL MMGATHER(NumMinVols,nobs,700,
     &              DATA(:,ind_kx ),WLSTMM,WKX ,NW)
 
      print *, 'finished final wind gathers'
       forall(igp=1:NumMinVols)
     &   WLAT(igp,NW(igp)+1:NW(igp)+max_nhgp) = GLAT(igp,1:max_nhgp)
       forall(igp=1:NumMinVols)
     &   WLON(igp,NW(igp)+1:NW(igp)+max_nhgp) = GLON(igp,1:max_nhgp)
       forall(igp=1:NumMinVols)
     &   WSTD(igp,NW(igp)+1:NW(igp)+max_nhgp) = GSTD(igp,1:max_nhgp)
 
      print *, 'from puv_prep_cov'
      print *, np
      print *, nw
      RETURN
      END
