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

      implicit none

c
c***  SUBROUTINE oldCMA_WRITE(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 write data to the Comprehensive Memory Array (CMA) file
c
c***  Externals:
c
c     PBWRITE    - Writes specified number of bytes to the CMA-file
c
c     Applicable to Cray PVP-versions only:
c
c     CRAY2IEG   - Converts Cray/PVP 64-bit f.p. to 64-bit IEEE-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 write:
                                   ! 0 = Write/update DDRs at the beginning
                                   !-1 = Write all the reports in pbuf
      integer, intent(in) :: kbufsize ! Length of the output pbuf-array
      real, intent(in) :: pbuf(kbufsize)  ! Output array
c***  Output variables
      integer, intent(out):: kret  ! Return code:
                                   !   >= 0 , # of dp-words written
                                   ! -1 = Error in writing data
                                   ! -3 = Real size not equal to 8 (bytes)
c-----------------------------------------------------------------------
! === END OF INTERFACE BLOCK ===

      integer ibufsize, ibufwritten, iret_pbio
      integer nobytes
      real zitem
#ifdef CRAY
#ifndef CMA_STACK_SIZE
#define CMA_STACK_SIZE 32 * 512
#endif
      integer, parameter :: jp_bufsize = CMA_STACK_SIZE
      real ztmp(jp_bufsize)
#endif

c-----------------------------------------------------------------------
c
c     1. Reposition the file at the beginning if writing DDRs
c        ----------------------------------------------------
c

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

c-----------------------------------------------------------------------
c
c     2. Write data into the file
c        ------------------------
c

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

      ibufwritten = 0

      do while (ibufwritten < kbufsize)
#ifdef CRAY
c
c     2.1 Exclusive for Cray PVP versions only:
c         Data is written in max chunks of CMA_STACK_SIZE -words 
c         (a /lib/cpp definable parameter)
c
#define zbuf ztmp
         ibufsize = min(jp_bufsize, kbufsize - ibufwritten)
#ifndef NO_IEEE
         call CLEARFI()
         call CRAY2IEG(8, ibufsize, ztmp, 0, pbuf(ibufwritten+1), 1)
         call SETFI()
#else
         ztmp(1:ibufsize) = pbuf(ibufwritten+1:ibufwritten+ibufsize)
#endif
#else
c
c     2.2 All other machines write data in a "one-shot"
c
#define zbuf pbuf
         ibufsize = kbufsize
#endif
         call PBWRITE(kunit, zbuf, nobytes * ibufsize, iret_pbio)
         
         if ( iret_pbio <  0 .or.
     $        iret_pbio /= nobytes * ibufsize ) then
            kret = -1
            return
         endif

         ibufwritten = ibufwritten + ibufsize
      enddo

      kret = ibufwritten

      return
      END SUBROUTINE oldCMA_WRITE
