#ifdef T3D
#ifdef CRAY
#undef CRAY  /* Since T3D is an IEEE-machine */
#endif
#endif
      SUBROUTINE oldCMA_READ(kunit, pbuf, kbufsize, kwhat, kret)

      implicit none

c
c***  SUBROUTINE oldCMA_READ(kunit, pbuf, kbufsize, kwhat, kret)
c
c     Sami Saarinen, ECMWF, 19/8/95
c     Sami Saarinen, ECMWF, 12/11/97 : gradually becomes obsolete
c
c***  Purpose:
c
c     To read data from the Comprehensive Memory Array (CMA) file
c
c***  Externals:
c
c     PBREAD2    - Reads specified number of bytes from the CMA-file
c     PBSEEK     - Repositions file if necessary
c     oldCMA_REWIND - Repositions file to the beginning
c
c     Applicable to Cray PVP-versions only:
c
c     IEG2CRAY   - Converts 64-bit IEEE-f.p. to Cray/PVP 64-bit f.p.
c     CLEARFI    - Clears the floating point interrupts
c     SETFI      - Resets the floating point interrupts
c
c***  Notes:
c
c     Coded in Fortran-90
c
c***  Input variables
      integer, intent(in) :: kunit ! PBIO file pointer
      integer, intent(in) :: kwhat ! Type of read:
                                   ! 0 = Read all DDRs into the buffer
                                   ! 1 = Read the next report
                                   ! n = Read the 'n' next reports
                                   !-1 = Read all the remaining reports
                                   !     or up to kbufsize w/o checking
                                   !     how many reports actually read
      integer, intent(in) :: kbufsize ! Length of the input pbuf-array
c***  Output variables
      real, intent(out):: pbuf(kbufsize)  ! Input array
      integer, intent(out):: kret  ! Return code:
                                   !   >= 0 , # of dp-words read
                                   ! -1 = Error in reading data
                                   ! -2 = kbufsize was not large
                                   !      enough to hold all the data
                                   ! -3 = Real size not equal to 8 (bytes)
c-----------------------------------------------------------------------
! === END OF INTERFACE BLOCK ===

      integer iret_pbio
      integer ireports, ibufread
      integer iback_off
      integer ilen_block, inext_ddr_len, ipbuf
      integer icurrent_pos, inew_pos
      integer nobytes
      real zitem

c-----------------------------------------------------------------------
c
c     1. Read a block of data from CMA-file
c        ----------------------------------
c
c
c     1.1 Rewind file if DDR's were needed
c         --------------------------------
c

      if (kwhat ==  0) call oldCMA_REWIND(kunit, iret_pbio)

c
c     1.2 Perform the read up to kbufsize-words and check the validity
c         of the data:
c         - the return code from PBIO must be non-negative
c         - number of bytes read must be divisible by 8
c
c     Actual number of words read is stored in ibufread.
c

      inquire(iolength=nobytes) zitem
      if (nobytes /= 8) then
         kret = -3
         return
      endif

      call PBREAD2(kunit, pbuf, nobytes * kbufsize, iret_pbio)

      if (  iret_pbio <  0 .or.
     $     (iret_pbio >  0 .and. mod(iret_pbio, nobytes) /= 0) ) then 
         kret = -1
         return
      endif

      ibufread = iret_pbio/nobytes

#ifdef CRAY
c
c     1.3 In case of Cray PVP, convert data from IEEE to CRAY-repr.
c         Disable and reset floating point interrupts before & after.
c
      if (ibufread > 0) then
#ifndef NO_IEEE
         call CLEARFI()
         call IEG2CRAY(8, ibufread, pbuf, 0, pbuf, 1)
         call SETFI()
#endif
      endif
#endif

c-----------------------------------------------------------------------
c
c     2. Make a quick check of the contents of the data
c        ----------------------------------------------
c
c
c     2.0 Check that either
c        - all DDR-blocks are read in
c        - all required observational data is read in
c

      kret  = ibufread          ! Number of 8 bytes words read

c
c     2.1 No checks are performed if data is read in a "one-shot"
c
c     *** It is under users' responsobility to provide enough space
c         so that complete set of reports fits into the given array ***
c

      if (kwhat  < 0) return

      ipbuf = 0                 ! Pointer to the beginning of array minus 1
      iback_off = 0             ! Number of words to back off at the end

      if (kwhat == 0) then

c
c     2.2 Data contains DDR-block
c         Return normally (after backing off) when all DDRs are found.
c         Return abnormally (kret < 0) if not enough data in pbuf.
c

         inext_ddr_len = ibufread  ! Guess the length of the next DDR-block

         do while (inext_ddr_len > 0)
            if (ipbuf + 1 > ibufread) then
c***  Warning:        ^^^   may, but unlikely to change !!!
               kret = -2
               return
            endif
            
            ilen_block = pbuf(ipbuf + 1) ! Actual length of current DDR-block
c***  Warning:                      ^^^   may, but unlikely to change !!!

            if (ipbuf + ilen_block > ibufread) then
               kret = -2
               return
            endif


            if (ipbuf + 8 > ibufread) then ! 
c***  Warning:        ^^^   may change !!!
               kret = -2
               return
            endif

            inext_ddr_len = pbuf(ipbuf + 8) ! Length of the next DDR-block
c***  Warning:                         ^^^   may change !!!
            ipbuf = ipbuf + ilen_block
         enddo


      else

c
c     2.3 Data is pure observational/report data
c         Return normally (after backing off) when required number of obs found.
c         Return abnormally (kret < 0) if not enough data in pbuf.
c

         ireports = 0           ! Number of reports found so far

         do while (ireports < kwhat)
            if (ipbuf + 1 > ibufread) then
c***  Warning:        ^^^   may, but unlikely to change !!!
               kret = -2
               return
            endif

            ilen_block = pbuf(ipbuf + 1)
c***  Warning:                      ^^^   may, but unlikely to change !!!

            if (ipbuf + ilen_block > ibufread) then
c***  Warning:        ^^^^^^^^^^^^   may, but unlikely to change !!!
               kret = -2
               return
            endif

            ipbuf = ipbuf + ilen_block
c***  Warning:            ^^^^^^^^^^^^   may, but unlikely to change !!!

            ireports = ireports + 1
         enddo

      endif

c-----------------------------------------------------------------------
c
c     3. Determine how much (if any) to back off and reposition the file
c        ---------------------------------------------------------------
c

      iback_off = ibufread - ipbuf ! Number of words to back off

      if (iback_off > 0) then
         call PBSEEK(kunit, 0, 1, iret_pbio) ! Get current position in bytes
         icurrent_pos = iret_pbio/nobytes    ! ... and in words (modulo 8)
         inew_pos     = icurrent_pos - iback_off
         call PBSEEK(kunit, nobytes * inew_pos, 0, iret_pbio) ! Goto to new pos
      endif

c
c     3.1 The actual number words needed
c

      kret = ipbuf

      return
      END SUBROUTINE oldCMA_READ
