!#ifdef RS6K
!@PROCESS NOCHECK
!#endif
MODULE IOSTREAM_MIX

!     Purpose.
!     --------

!      IOSTREAM_MIX contains data and routines for the generalized IO package

!     Author.
!     -------
!     Mats Hamrud(ECMWF)

!     Modifications.
!     --------------
!        Original : 2005-12-01
!        M Fisher : 2007-08-06 Raw I/O of character strings
!        S Martinez 24-June-2009 : SX9 compiler workaround : re-write some loops
!                in a more robust way ; especially avoiding fully implicit
!                synthax array (thanks to E.Sevault).
!        R. El Khatib 03-Jul-2009 Add missing NULLIFY statements
!        E. Sevault 09-Jul-2009 Securize workaround above.
!        E. Holm  : 2009-12-18 Correct raw format character write in io_put
!-------------------------------------------------------------------------

USE PARKIND1 , ONLY : JPIM     ,JPIB     ,JPRB
USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_RECV, MPL_SEND, MPL_BARRIER,&
 & MPL_WAIT, JP_NON_BLOCKING_STANDARD, JP_BLOCKING_STANDARD, MPL_GATHERV, &
 & MPL_TASK_PER_NODE, MPL_NNODES, MPL_NODE_TASKS, MPL_NODE, MPL_NPROC, MPL_MYRANK
USE ECSORT_MIX   , ONLY : KEYSORT, GET_RANK
USE FDBSUBS_MOD  , ONLY : IOPENFDBSUBS, ICLOSEFDBSUBS, ISETVALFDBSUBS,&
 & ISETFIELDCOUNTFDBSUBS, IWRITEFDBSUBS, IFLUSHFDBSUBS
USE YOM_GRIB_CODES
USE FITSPECTRUM_MOD, ONLY: FITSPECTRUM
USE YOMHOOK  , ONLY : LHOOK,   DR_HOOK
USE GRIB_API_INTERFACE

IMPLICIT NONE
SAVE

!     -------------------------------------------------------------------------
PRIVATE
PUBLIC TYPE_IOSTREAM,TYPE_IOREQUEST,&
 & TYPE_3D_MDL_FLDS, TYPE_2D_MDL_FLDS, TYPE_SPECTRAL_FLD_DEF,&
 & TYPE_GRIDPOINT_FLD_DEF, &
 & SETUP_IOSTREAM,SETUP_IOREQUEST,IO_PUT,IO_GET,&
 & CLOSE_IOSTREAM,CLOSE_IOREQUEST,Y_IOSTREAM_FDB,IO_INQUIRE,IOSTREAM_STATS,&
 & FLUSH_IOSTREAM,INQUIRE_GRIB,INI_IOSTREAM,&
 & NGRIB_HANDLE_SH,NGRIB_HANDLE_SH_ML,NGRIB_HANDLE_GG,NGRIB_HANDLE_GG_ML

INTEGER(KIND=JPIM) :: NGRIB_HANDLE_SH=-99
INTEGER(KIND=JPIM) :: NGRIB_HANDLE_SH_ML=-99
INTEGER(KIND=JPIM) :: NGRIB_HANDLE_GG=-99
INTEGER(KIND=JPIM) :: NGRIB_HANDLE_GG_ML=-99

INTEGER(KIND=JPIM),PARAMETER :: JPNONDEF = -99
INTEGER(KIND=JPIM),PARAMETER :: JPMAXCHUNK = 4096

INTEGER(KIND=JPIM),PARAMETER :: JPFDB=1
INTEGER(KIND=JPIM),PARAMETER :: JPCIO=2
INTEGER(KIND=JPIM),PARAMETER :: JPFTN=3

TYPE TYPE_IOSTREAM

INTEGER(KIND=JPIM) :: IOTYPE   = 0
INTEGER(KIND=JPIM) :: IFILE_HANDLE  = JPNONDEF
INTEGER(KIND=JPIM) :: IOMASTER = JPNONDEF
CHARACTER(LEN=1)   :: CMODE    = 'r'
CHARACTER(LEN=120) :: CPATH
CHARACTER(LEN=120) :: CREF
LOGICAL            :: LEOF
INTEGER(KIND=JPIM) :: NRECS
INTEGER(KIND=JPIB) :: NBYTES 
LOGICAL            :: LIOPROC
LOGICAL            :: LIOPROCHLP
LOGICAL            :: LIOUSEHELP
LOGICAL            :: LIONOHELP
INTEGER(KIND=JPIM),POINTER :: IOPROCS(:)
INTEGER(KIND=JPIM),POINTER :: IOPROCSHLP(:,:)
INTEGER(KIND=JPIM),POINTER :: NUMHLP(:)
INTEGER(KIND=JPIM) :: NUMIOPROCS
INTEGER(KIND=JPIM) :: MIOPROCHLP
INTEGER(KIND=JPIM) :: NUMIOPROCSHLP
REAL(KIND=JPRB)    :: WALLCLOCK
REAL(KIND=JPRB)    :: TOTWALL

END TYPE TYPE_IOSTREAM


INTEGER(KIND=JPIM),PARAMETER :: JPRAW=1
INTEGER(KIND=JPIM),PARAMETER :: JPSPEC=2
INTEGER(KIND=JPIM),PARAMETER :: JPGP=3

TYPE TYPE_3D_MDL_FLDS
INTEGER(KIND=JPIM) :: NUMFLDS
INTEGER(KIND=JPIM) :: NLEVS
INTEGER(KIND=JPIM),POINTER :: ILEVS(:)
INTEGER(KIND=JPIM),POINTER :: IGRIBCODE(:)
INTEGER(KIND=JPIM),POINTER :: IBSET(:)
INTEGER(KIND=JPIM),POINTER :: ILOCLEV(:)
END TYPE TYPE_3D_MDL_FLDS

TYPE TYPE_2D_MDL_FLDS
INTEGER(KIND=JPIM) :: NUMFLDS
INTEGER(KIND=JPIM),POINTER :: IGRIBCODE(:)
INTEGER(KIND=JPIM),POINTER :: ILEVS(:)
INTEGER(KIND=JPIM),POINTER :: IBSET(:)
INTEGER(KIND=JPIM),POINTER :: ILOCFLD(:)
END TYPE TYPE_2D_MDL_FLDS

TYPE TYPE_SPECTRAL_FLD_DEF
INTEGER(KIND=JPIM) :: ISMAX
INTEGER(KIND=JPIM) :: ISPEC2G
INTEGER(KIND=JPIM) :: ISPEC2
END TYPE TYPE_SPECTRAL_FLD_DEF

TYPE TYPE_GRIDPOINT_FLD_DEF
INTEGER(KIND=JPIM) :: IGPTOTG
INTEGER(KIND=JPIM) :: IGPTOT
INTEGER(KIND=JPIM) :: NPROMA
END TYPE TYPE_GRIDPOINT_FLD_DEF

TYPE TYPE_IOREQUEST
INTEGER(KIND=JPIM) :: IDATA_TYPE = JPNONDEF  ! Type of data
LOGICAL            :: LGRIB    = .FALSE.     ! Data GRIB coded
LOGICAL            :: LRANDOM_ORDER ! Data read in random order
LOGICAL            :: LFPDIST       ! Data in FullPos distribution
LOGICAL            :: LINTERP       ! Fields to be interpolatad
LOGICAL            :: LDISTRIBUTE   ! Fields distributed
LOGICAL            :: LGEOPRESET    ! Use geography from imported GRIB header
LOGICAL            :: LREADALL      ! Read all of file even of all fields found
LOGICAL            :: LINQUIRE      ! Use inquire mode
LOGICAL            :: LATLONG       ! Grid-point data in lat/long grid
LOGICAL            :: LINTONLY      ! Interogate only mode (disable checks)
INTEGER(KIND=JPIM) :: NTYPE_INTERP  ! Type of interpolation
CHARACTER(LEN=3)   :: CLEVTYPE = 'SFC'    ! Level type
CHARACTER(LEN=1)   :: CLEVTYPE_FDB = 's' ! As above for FDB
TYPE(TYPE_3D_MDL_FLDS) :: YMDL_3D
TYPE(TYPE_2D_MDL_FLDS) :: YMDL_2D
TYPE(TYPE_SPECTRAL_FLD_DEF) :: YSPF
TYPE(TYPE_GRIDPOINT_FLD_DEF) :: YGPF
!TYPE(GRIB_HEADER) :: YGRBH
INTEGER(KIND=JPIM) :: ILEV
INTEGER(KIND=JPIM) :: IGRBCODE
INTEGER(KIND=JPIM),POINTER :: ILEVS(:)
INTEGER(KIND=JPIM),POINTER :: IGRBCODES(:)
INTEGER(KIND=JPIM),POINTER :: IHAVEFLD(:)
CHARACTER(LEN=32)  :: CREPRT
INTEGER(KIND=JPIM) :: IRESOLI
INTEGER(KIND=JPIM) :: NCHUNKSIZE
INTEGER(KIND=JPIM) :: IFIELDS_IO
INTEGER(KIND=JPIM) :: IGRIB_HANDLE
INTEGER(KIND=JPIM) :: IVALUES
INTEGER(KIND=JPIM) :: IFIELDS_HAVE
END TYPE TYPE_IOREQUEST

TYPE TYPE_INT_VARS
INTEGER(KIND=JPIM) :: NUNDEF
INTEGER(KIND=JPIM) :: NULERR
INTEGER(KIND=JPIM) :: NULOUT
INTEGER(KIND=JPIM) :: MYPROC
INTEGER(KIND=JPIM) :: NPROC
INTEGER(KIND=JPIM) :: IMAXGRID
INTEGER(KIND=JPIM) :: IMAXSPEC2G
REAL(KIND=JPRB)    :: RPI
REAL(KIND=JPRB)    :: SIPR
INTEGER(KIND=JPIM) :: NREALEN
INTEGER(KIND=JPIM) :: NINTLEN
INTEGER(KIND=JPIM),POINTER :: NBSETLEV(:)
INTEGER(KIND=JPIM) :: NBSETSP
INTEGER(KIND=JPIM) :: NFLEVG
INTEGER(KIND=JPIM) :: NSMAX
INTEGER(KIND=JPIM) :: NDGLG
INTEGER(KIND=JPIM),POINTER :: NLOENG(:)
REAL(KIND=JPRB),POINTER :: VAH(:)
REAL(KIND=JPRB),POINTER :: VBH(:)
REAL(KIND=JPRB),POINTER :: RLATIG(:)
INTEGER(KIND=JPIM),POINTER :: NUMPROCFP(:)
INTEGER(KIND=JPIM) :: NFPRGPL
INTEGER(KIND=JPIM) :: NFPRGPG
INTEGER(KIND=JPIM) :: NFPRGPLX
INTEGER(KIND=JPIM),POINTER :: NFPMAX(:)
LOGICAL            :: LIFS_INTERNAL
END TYPE TYPE_INT_VARS

#ifdef RS6K
! xlf90 bug
TYPE(TYPE_IOSTREAM),SAVE :: Y_IOSTREAM_FDB
TYPE(TYPE_INT_VARS),SAVE :: YIOS
#else
TYPE(TYPE_IOSTREAM) :: Y_IOSTREAM_FDB
TYPE(TYPE_INT_VARS) :: YIOS
#endif

LOGICAL            :: LPACK_INIT=.FALSE.
INTEGER(KIND=JPIM) :: NIOSTREAMC = 0
INTEGER(KIND=JPIM) :: NOPENIOSTREAMS = 0
INTEGER(KIND=JPIM) :: NOPENEDIOSTREAMS = 0
REAL(KIND=JPRB)    :: TOTAL_WALLCLOCK = 0.0_JPRB
REAL(KIND=JPRB)    :: WALLCLOCK_OUT = 0.0_JPRB
REAL(KIND=JPRB)    :: TOTWALL_OUT = 0.0_JPRB
INTEGER(KIND=JPIM) :: NRECS_OUT = 0
INTEGER(KIND=JPIB) :: NBYTES_OUT = 0
REAL(KIND=JPRB)    :: WALLCLOCK_IN = 0.0_JPRB
REAL(KIND=JPRB)    :: TOTWALL_IN = 0.0_JPRB
INTEGER(KIND=JPIM) :: NRECS_IN = 0
INTEGER(KIND=JPIB) :: NBYTES_IN = 0
INTEGER(KIND=JPIM),ALLOCATABLE,TARGET :: NGRIBD(:)
INTEGER(KIND=JPIM),ALLOCATABLE        :: NGRIBMSG(:)
INTEGER(KIND=JPIM),ALLOCATABLE,TARGET :: NGSTA(:)
LOGICAL,ALLOCATABLE :: LGRIBDONE(:)

INTERFACE
#include "trans_inq.h"
#include "gath_spec.h"
#include "dist_spec.h"
#include "gath_grid.h"
#include "dist_grid.h"
#include "user_clock.h"
END INTERFACE

#include "abor1.intfb.h"
#include "grib_code_message.intfb.h"
#include "interp_gp.intfb.h"
#include "spint.intfb.h"

CONTAINS
!======================================================================
SUBROUTINE INI_IOSTREAM(KULOUT,KBSETLEV,KBSETSP,KFLEVG,KSMAX,KDGLG,PVAH,PVBH,KLOENG,&
 & PLATIG,KNUMPROCFP,KFPRGPL,KFPRGPG ,KFPRGPLX, KFPMAX,LDIFS_INTERNAL)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KULOUT
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KBSETLEV(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KBSETSP
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KFLEVG
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KSMAX
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KDGLG
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN)  :: PVAH(:)
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN)  :: PVBH(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KLOENG(:)
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN)  :: PLATIG(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KNUMPROCFP(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KFPRGPL
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KFPRGPG
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KFPRGPLX
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KFPMAX(:)
LOGICAL           ,OPTIONAL,INTENT(IN)  :: LDIFS_INTERNAL
REAL(KIND=JPRB)    :: ZZ(2)
INTEGER(KIND=JPIM) :: II(2)
INTEGER(KIND=JPIM), EXTERNAL :: N_PRECISION
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
!----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:INI_IOSTREAM',0,ZHOOK_HANDLE)
IF(.NOT.LPACK_INIT) THEN
  YIOS%NUNDEF = -HUGE(II)
  YIOS%NULERR = 0
  YIOS%NULOUT = 6
  YIOS%MYPROC = MPL_MYRANK()
  YIOS%NPROC  = MPL_NPROC()
  YIOS%IMAXGRID = 2*2056*2056
  YIOS%IMAXSPEC2G = 2049*2050
  YIOS%RPI      = 2.0_JPRB*ASIN(1.0_JPRB)
  YIOS%SIPR     = 100000._JPRB
  ZZ(:) = 1.0_JPRB
  II(:) = 1
  YIOS%NINTLEN = N_PRECISION(II)
  YIOS%NREALEN = N_PRECISION(ZZ)
  LPACK_INIT = .TRUE.
  NULLIFY(YIOS%NBSETLEV)
  YIOS%NBSETSP=YIOS%NUNDEF
  YIOS%NFLEVG=YIOS%NUNDEF
  YIOS%NSMAX=YIOS%NUNDEF
  YIOS%NDGLG=YIOS%NUNDEF
  NULLIFY(YIOS%VAH)
  NULLIFY(YIOS%VBH)
  NULLIFY(YIOS%NLOENG)
  NULLIFY(YIOS%RLATIG)
  NULLIFY(YIOS%NUMPROCFP)
  YIOS%LIFS_INTERNAL=.FALSE.
ENDIF
IF(PRESENT(KULOUT)) YIOS%NULOUT=KULOUT
IF(PRESENT(KBSETSP)) YIOS%NBSETSP=KBSETSP
IF(PRESENT(KBSETLEV)) THEN
  ALLOCATE(YIOS%NBSETLEV(SIZE(KBSETLEV)))
  YIOS%NBSETLEV(:)=KBSETLEV(:)
ENDIF
IF(PRESENT(KFLEVG)) YIOS%NFLEVG = KFLEVG
IF(PRESENT(KSMAX))  YIOS%NSMAX  = KSMAX
IF(PRESENT(KDGLG))  YIOS%NDGLG  = KDGLG
IF(PRESENT(PVAH)) THEN
  ALLOCATE(YIOS%VAH(SIZE(PVAH)))
  YIOS%VAH(:)=PVAH(:)
ENDIF
IF(PRESENT(PVBH)) THEN
  ALLOCATE(YIOS%VBH(SIZE(PVBH)))
  YIOS%VBH(:)=PVBH(:)
ENDIF
IF(PRESENT(KLOENG)) THEN
  ALLOCATE(YIOS%NLOENG(SIZE(KLOENG)))
  YIOS%NLOENG(:)=KLOENG(:)
ENDIF
IF(PRESENT(PLATIG)) THEN
  ALLOCATE(YIOS%RLATIG(SIZE(PLATIG)))
  YIOS%RLATIG(:)=PLATIG(:)
ENDIF
IF(PRESENT(KNUMPROCFP)) THEN
  IF(ASSOCIATED(YIOS%NUMPROCFP)) THEN
    IF(SIZE(YIOS%NUMPROCFP) /= SIZE(KNUMPROCFP)) DEALLOCATE(YIOS%NUMPROCFP)
  ENDIF
  IF(.NOT.ASSOCIATED(YIOS%NUMPROCFP)) THEN
    ALLOCATE(YIOS%NUMPROCFP(SIZE(KNUMPROCFP)))
  ENDIF
  YIOS%NUMPROCFP(:)=KNUMPROCFP(:)
ENDIF
IF(PRESENT(KFPRGPL)) YIOS%NFPRGPL=KFPRGPL
IF(PRESENT(KFPRGPG)) YIOS%NFPRGPG=KFPRGPG
IF(PRESENT(KFPRGPLX)) YIOS%NFPRGPLX=KFPRGPLX
IF(PRESENT(KFPMAX)) THEN
  IF(ASSOCIATED(YIOS%NFPMAX)) THEN
    IF(SIZE(YIOS%NFPMAX) /= SIZE(KFPMAX)) DEALLOCATE(YIOS%NFPMAX)
  ENDIF
  IF(.NOT.ASSOCIATED(YIOS%NFPMAX)) THEN
    ALLOCATE(YIOS%NFPMAX(SIZE(KFPMAX)))
  ENDIF
  YIOS%NFPMAX(:)=KFPMAX(:)
ENDIF
IF(PRESENT(LDIFS_INTERNAL)) YIOS%LIFS_INTERNAL=LDIFS_INTERNAL
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:INI_IOSTREAM',1,ZHOOK_HANDLE)
END SUBROUTINE INI_IOSTREAM
!======================================================================
SUBROUTINE SETUP_IOSTREAM(YD,CDTYPE,CDPATH,CDMODE,CDREF,KIOMASTER,&
 & KIOPROCS,LDNOHELP)

!**** *SETUP_IOSTREAM*  - Setup IO stream

! Purpose - To initiate an io-stream, open file if applicable etc.

! Explicit arguments :
! --------------------
! YD        - IO stream structure
! CDTYPE    - IO type (PBIO,FDB ...)
! CDPATH    - File path name
! CDMODE    - read/write/append mode
! CDREF     - reference (needed for FDB)
! KIOMASTER - processor to perform IO (takes presedence over KIOPROCS if present)
! KIOPROCS  - processors to perform IO (in neither KIOPROCS or KIOMASTER present 
!             all processors do perform IO)
! LDNOHELP  - if true don't use io helpers

!-------------------------------------------------------------------------
IMPLICIT NONE


TYPE(TYPE_IOSTREAM)        ,INTENT(INOUT) :: YD
CHARACTER(LEN=*)           ,INTENT(IN)    :: CDTYPE
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(IN)    :: CDPATH
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(IN)    :: CDREF
CHARACTER(LEN=1)  ,OPTIONAL,INTENT(IN)    :: CDMODE
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)    :: KIOMASTER
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)    :: KIOPROCS(:)
LOGICAL           ,OPTIONAL,INTENT(IN)    :: LDNOHELP

INTEGER(KIND=JPIM) :: IRET,JROC,IROC,INODE
INTEGER(KIND=JPIM) :: JHELP,IOPROC,JLOC,IPROC,IHELP,JNODE
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
REAL(KIND=JPRB)    :: ZTIME0,ZTIME1
LOGICAL            :: LLUSED(YIOS%NPROC)

!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:SETUP_IOSTREAM',0,ZHOOK_HANDLE)
IF(.NOT. LPACK_INIT) CALL ABOR1('IOSTREAM_MIX:SETUP_IOSTREAM - CALL INI_IOSTREAM FIRST')
CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)

! Set defaults
NULLIFY(YD%IOPROCS)
YD%LEOF       = .FALSE.
YD%NRECS      = 0
YD%NBYTES     = 0
YD%LIOPROC    = .FALSE.
YD%LIOPROCHLP = .FALSE.
YD%LIONOHELP  = .FALSE.
YD%LIOUSEHELP = .FALSE.
YD%NUMIOPROCS = 0
YD%NUMIOPROCSHLP = 0
YD%MIOPROCHLP = -99
YD%CREF       = 'UNDEF'
YD%CPATH      = 'UNDEF'
YD%CMODE      = 'r'
YD%IOMASTER   = JPNONDEF
!Statistics
YD%WALLCLOCK    = 0.0_JPRB
YD%TOTWALL      = 0.0_JPRB
NIOSTREAMC      = NIOSTREAMC+1
NOPENIOSTREAMS  = NOPENIOSTREAMS+1
NOPENEDIOSTREAMS  = NOPENEDIOSTREAMS+1
YD%IFILE_HANDLE = NIOSTREAMC

! Process arguments
IF(PRESENT(KIOMASTER)) THEN     ! Only one IO processor
  YD%IOMASTER = KIOMASTER
  YD%NUMIOPROCS = 1
  YD%NUMIOPROCSHLP = YIOS%NPROC
  ALLOCATE(YD%IOPROCS(YD%NUMIOPROCS))
  ALLOCATE(YD%IOPROCSHLP(YD%NUMIOPROCS,YD%NUMIOPROCSHLP))
  ALLOCATE(YD%NUMHLP(YD%NUMIOPROCS))
  YD%IOPROCS(1) = KIOMASTER
  YD%NUMHLP(1)=YD%NUMIOPROCSHLP
  YD%IOPROCSHLP(:,:)=0
  IROC=YD%IOPROCS(1)-1
  INODE=MPL_NODE(YD%IOPROCS(1))-1
  IHELP=1
  YD%IOPROCSHLP(1,IHELP)=YD%IOPROCS(1)
  OUTER:DO JNODE=1,MPL_NNODES
    INODE=INODE+1
    IF(INODE > MPL_NNODES) INODE=1
    DO JROC=1,MPL_TASK_PER_NODE(INODE)
      IF(MPL_NODE_TASKS(INODE,JROC) /= YD%IOPROCSHLP(1,1)) THEN
        IHELP =IHELP+1
        YD%IOPROCSHLP(1,IHELP)=MPL_NODE_TASKS(INODE,JROC)
      ENDIF
      IF(IHELP == YD%NUMIOPROCSHLP) EXIT OUTER
    ENDDO
  ENDDO OUTER
  IF(YD%IOMASTER == YIOS%MYPROC) THEN
    YD%LIOPROC  = .TRUE.
  ENDIF
ELSEIF(PRESENT(KIOPROCS)) THEN  ! Possibly multiple IO processors

  IF(KIOPROCS(1) == -1) THEN    ! All processors do IO
    YD%LIOPROC  = .TRUE.
    YD%NUMIOPROCS = YIOS%NPROC
    YD%NUMIOPROCSHLP = YIOS%NPROC
    ALLOCATE(YD%IOPROCS(YD%NUMIOPROCS))
    ALLOCATE(YD%NUMHLP(YD%NUMIOPROCS))
    ALLOCATE(YD%IOPROCSHLP(YD%NUMIOPROCS,YD%NUMIOPROCSHLP))
    YD%IOPROCSHLP(:,:)=0
    DO JROC=1,YD%NUMIOPROCS
      YD%IOPROCS(JROC) = JROC
      YD%NUMHLP(JROC)=1
      YD%IOPROCSHLP(JROC,JROC)=YD%IOPROCS(JROC)
    ENDDO
  ELSE
    IF(IFIND(YIOS%MYPROC,KIOPROCS(:)) >0) THEN
      YD%LIOPROC  = .TRUE.
    ENDIF
    YD%NUMIOPROCS = SIZE(KIOPROCS)
    ALLOCATE(YD%IOPROCS(YD%NUMIOPROCS))
    IHELP=YIOS%NPROC/YD%NUMIOPROCS
    YD%NUMIOPROCSHLP = YD%NUMIOPROCS*IHELP
    ALLOCATE(YD%NUMHLP(YD%NUMIOPROCS))
    ALLOCATE(YD%IOPROCSHLP(YD%NUMIOPROCS,YD%NUMIOPROCSHLP))
    YD%IOPROCSHLP(:,:)=0
    DO JROC=1,YD%NUMIOPROCS
      IF(KIOPROCS(JROC) < 1 .OR. KIOPROCS(JROC) > YIOS%NPROC) THEN
        WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX:SETUP_IOSTREAM ',JROC,KIOPROCS(JROC)
        CALL ABOR1('IOSTREAM_MIX:SETUP_IOSTREAM - ILLEGAL  KIOPROCS')
      ENDIF
      YD%IOPROCS(JROC) = KIOPROCS(JROC)
    ENDDO
    LLUSED(:)=.FALSE.
    DO JROC=1,YD%NUMIOPROCS
      YD%NUMHLP(JROC)=1
      YD%IOPROCSHLP(JROC,1)=YD%IOPROCS(JROC)
      LLUSED(YD%IOPROCS(JROC))=.TRUE.
    ENDDO
    DO JHELP=1,IHELP
      DO JROC=1,YD%NUMIOPROCS
        IOPROC=YD%IOPROCS(JROC)
        INODE=MPL_NODE(IOPROC)
        DO JLOC=1,MPL_TASK_PER_NODE(INODE)
          IPROC=MPL_NODE_TASKS(INODE,JLOC)
          IF(IPROC > 0 .AND. IPROC <= YIOS%NPROC) THEN
            IF(.NOT.LLUSED(IPROC)) THEN
              YD%NUMHLP(JROC)=YD%NUMHLP(JROC)+1
              YD%IOPROCSHLP(JROC,YD%NUMHLP(JROC))=IPROC
              LLUSED(IPROC)=.TRUE.
            ENDIF
          ENDIF
        ENDDO
      ENDDO
    ENDDO
  ENDIF
ELSE    ! All processors do IO 
  YD%LIOPROC  = .TRUE.
  YD%NUMIOPROCS = YIOS%NPROC
  ALLOCATE(YD%IOPROCS(YD%NUMIOPROCS))
  YD%NUMIOPROCSHLP = YD%NUMIOPROCS
  ALLOCATE(YD%NUMHLP(YD%NUMIOPROCS))
  ALLOCATE(YD%IOPROCSHLP(YD%NUMIOPROCS,YD%NUMIOPROCSHLP))
  YD%IOPROCSHLP(:,:)=0
  DO JROC=1,YD%NUMIOPROCS
    YD%IOPROCS(JROC) = JROC
    YD%NUMHLP(JROC)=1
    YD%IOPROCSHLP(JROC,1)=YD%IOPROCS(JROC)
  ENDDO
ENDIF
DO JROC=1,YD%NUMIOPROCS
  IF(IFIND(YIOS%MYPROC,YD%IOPROCSHLP(JROC,:)) >0) THEN
    IF(YIOS%MYPROC /= YD%IOPROCS(JROC)) THEN
      YD%LIOPROCHLP  = .TRUE.
      YD%MIOPROCHLP  = YD%IOPROCS(JROC)
    ENDIF
  ENDIF
ENDDO
IF(PRESENT(CDMODE)) YD%CMODE = CDMODE
IF(PRESENT(LDNOHELP)) YD%LIONOHELP = LDNOHELP
CALL GSTATS(1752,0)
! Set IO type
SELECT CASE(CDTYPE)
CASE('FDB')
  YD%IOTYPE = JPFDB
  IF(PRESENT(CDREF)) THEN
    YD%CREF = CDREF 
  ELSE
    CALL ABOR1('IOSTREAM_MIX:SETUP_IOSTREAM - FDB REF REQUIRED')
  ENDIF
  IRET = IOPENFDBSUBS(YD%CREF,YD%IFILE_HANDLE,'w')
  IF(IRET /= 0) THEN
    WRITE(YIOS%NULERR,'(A,I4)') 'ERROR OPENING FDB,IRET = ',IRET
    CALL ABOR1('IOSTREAM_MIX:SETUP_IOSTREAM - ERROR OPENING FDB')
  ENDIF
CASE('CIO')
  YD%IOTYPE = JPCIO
  IF(PRESENT(CDPATH)) THEN
    YD%CPATH = CDPATH 
  ELSE
    CALL ABOR1('IOSTREAM_MIX:SETUP_IOSTREAM - PATH REQUIRED')
  ENDIF
  IF( YD%LIOPROC ) THEN
    CALL IGRIB_OPEN_FILE(YD%IFILE_HANDLE,TRIM(YD%CPATH),YD%CMODE)
    ENDIF
CASE DEFAULT
  CALL ABOR1('IOSTREAM_MIX:SETUP_IOSTREAM - UNKNOWN IO TYPE')
END SELECT
CALL GSTATS(1752,1)

WRITE(YIOS%NULOUT,*) 'IO-STREAM SETUP - IOTYPE =',YD%IOTYPE,' NUMIOPROCS =',&
 & YD%NUMIOPROCS,' CPATH =',TRIM(YD%CPATH),' MODE=',YD%CMODE

CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
YD%TOTWALL = YD%TOTWALL+(ZTIME1-ZTIME0)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:SETUP_IOSTREAM',1,ZHOOK_HANDLE)

END SUBROUTINE SETUP_IOSTREAM
!=============================================================
SUBROUTINE CLOSE_IOSTREAM(YD)

!**** *CLOSE_IOSTREAM*  - Close IO stream

! Purpose - To release an io-stream, close file if applicable etc.

! Explicit arguments :
! --------------------
! YD        - IO stream structure

!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT) :: YD

INTEGER(KIND=JPIM) :: IRET,JROC,ITAG,IROC,ISENDREQ
INTEGER(KIND=JPIB) :: IBYTES(YIOS%NPROC)
INTEGER(KIND=JPIM) :: IRECS(YIOS%NPROC)
REAL(KIND=JPRB)    :: ZMBYTES_PER_SEC,ZPERC
REAL(KIND=JPRB)    :: ZWALL(YIOS%NPROC),ZTOTWALL(YIOS%NPROC),ZBUF(4)
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
REAL(KIND=JPRB)    :: ZTIME0,ZTIME1

!-------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:CLOSE_IOSTREAM',0,ZHOOK_HANDLE)
CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)

! Close file, handle etc.
CALL GSTATS(1753,0)
SELECT CASE(YD%IOTYPE)
CASE(JPCIO)
IF(YD%LIOPROC) THEN
  CALL IGRIB_CLOSE_FILE(YD%IFILE_HANDLE)
ENDIF
CASE(JPFDB)
  IRET = ICLOSEFDBSUBS(YD%IFILE_HANDLE)
END SELECT
CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
YD%TOTWALL = YD%TOTWALL+(ZTIME1-ZTIME0)
CALL GSTATS(1753,1)

! Write out IO statistics
ZWALL (YIOS%MYPROC) = YD%WALLCLOCK
ZTOTWALL (YIOS%MYPROC) = YD%TOTWALL
IRECS (YIOS%MYPROC) = YD%NRECS
IBYTES(YIOS%MYPROC) = YD%NBYTES
IF(YD%CMODE == 'r' .OR. YD%CMODE == 'R') THEN
  WALLCLOCK_IN = WALLCLOCK_IN+YD%WALLCLOCK
  TOTWALL_IN = TOTWALL_IN+YD%TOTWALL
  NRECS_IN  = NRECS_IN+YD%NRECS
  NBYTES_IN = NBYTES_IN+YD%NBYTES
ELSE
  WALLCLOCK_OUT = WALLCLOCK_OUT+YD%WALLCLOCK
  TOTWALL_OUT = TOTWALL_OUT+YD%TOTWALL
  NRECS_OUT  = NRECS_OUT+YD%NRECS
  NBYTES_OUT = NBYTES_OUT+YD%NBYTES
ENDIF
IF(YD%NUMIOPROCS > 1 .OR. YD%IOMASTER /= 1) THEN
  CALL GSTATS_BARRIER(745)
  CALL GSTATS(629,0)
  ITAG = 20000
  IF(YIOS%MYPROC == 1) THEN
    DO JROC=1,YD%NUMIOPROCS
      IF(YD%IOPROCS(JROC) /= YIOS%MYPROC) THEN
        CALL MPL_RECV(ZBUF,KSOURCE=YD%IOPROCS(JROC),KTAG=ITAG,&
         & KMP_TYPE=JP_BLOCKING_STANDARD,CDSTRING='IOSTREAM_MIX:CLOSE_IOSTREAM')
        IBYTES(YD%IOPROCS(JROC)) = ZBUF(1)
        IRECS (YD%IOPROCS(JROC)) = ZBUF(2)
        ZWALL (YD%IOPROCS(JROC)) = ZBUF(3)
        ZTOTWALL (YD%IOPROCS(JROC)) = ZBUF(4)
      ENDIF
    ENDDO
  ELSEIF(YD%LIOPROC) THEN
    ZBUF(1) = YD%NBYTES
    ZBUF(2) = YD%NRECS
    ZBUF(3) = YD%WALLCLOCK
    ZBUF(4) = YD%TOTWALL
    CALL MPL_SEND(ZBUF,KDEST=1,KTAG=ITAG,&
     & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ, &
     & CDSTRING='IOSTREAM_MIX:CLOSE_IOSTREAM')
    CALL MPL_WAIT(ZBUF,KREQUEST=ISENDREQ, &
     & CDSTRING='IOSTREAM_MIX:CLOSE_IOSTREAM')
  ENDIF
  CALL GSTATS(629,1)
  CALL GSTATS_BARRIER2(745)
ENDIF
IF(YIOS%MYPROC == 1) THEN
  WRITE(YIOS%NULOUT,*) 'IO-STREAM CLOSED - ',TRIM(YD%CPATH)
  DO JROC=1,YD%NUMIOPROCS
    IROC = YD%IOPROCS(JROC)
    IF(ZWALL(IROC) > 0.0_JPRB) THEN
      ZMBYTES_PER_SEC = IBYTES(IROC)/ZWALL(IROC)*1.E-6_JPRB
    ELSE
      ZMBYTES_PER_SEC = 0.0_JPRB
    ENDIF
    IF(ZTOTWALL(IROC) > 0.0_JPRB) THEN
      ZPERC = ZWALL(IROC)/ZTOTWALL(IROC)*100._JPRB
    ELSE
      ZPERC = 0.0_JPRB
    ENDIF
    WRITE(YIOS%NULOUT,'(1X,A,I4,A,I10,A,I6,A,F10.4,A,F8.1,A,F10.4,A,F6.1,A)') &
     & 'MPI-TASK:',IROC,' - ',&
     & IBYTES(IROC),' BYTES IN ' ,IRECS(IROC),&
     & ' RECORDS TRANSFERRED IN', ZWALL(IROC),' SECONDS',&
     & ZMBYTES_PER_SEC,' Mbytes/s, TOTAL TIME=',ZTOTWALL(IROC),&
     & '(',ZPERC,'%)'
  ENDDO
ENDIF

! Reset default values, free space
YD%IOTYPE = JPNONDEF
YD%IOMASTER = JPNONDEF
YD%LIOPROC = .FALSE.
DEALLOCATE(YD%IOPROCS)
DEALLOCATE(YD%IOPROCSHLP)
DEALLOCATE(YD%NUMHLP)
YD%NUMIOPROCS = JPNONDEF
YD%NUMIOPROCSHLP = JPNONDEF
YD%MIOPROCHLP = JPNONDEF
YD%IFILE_HANDLE = JPNONDEF
NOPENIOSTREAMS = NOPENIOSTREAMS-1

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:CLOSE_IOSTREAM',1,ZHOOK_HANDLE)

END SUBROUTINE CLOSE_IOSTREAM

!=============================================================

SUBROUTINE FLUSH_IOSTREAM(YD)

!**** *FLUSH_IOSTREAM*  - Flush IO stream

! Purpose - To flush an io-stream (only fdb presently)

! Explicit arguments :
! --------------------
! YD        - IO stream structure

!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT) :: YD

INTEGER(KIND=JPIM) :: IRET
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
REAL(KIND=JPRB)    :: ZTIME0,ZTIME1

!-------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:FLUSH_IOSTREAM',0,ZHOOK_HANDLE)
CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)

! Flush
SELECT CASE(YD%IOTYPE)
CASE(JPFDB)
  IRET = IFLUSHFDBSUBS(YD%IFILE_HANDLE)
END SELECT
CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
YD%TOTWALL = YD%TOTWALL+(ZTIME1-ZTIME0)

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:FLUSH_IOSTREAM',1,ZHOOK_HANDLE)

END SUBROUTINE FLUSH_IOSTREAM
!=============================================================
SUBROUTINE IOSTREAM_STATS
IMPLICIT NONE
INTEGER(KIND=JPIM),PARAMETER :: JPLENM=11
INTEGER(KIND=JPIM) :: IOPEN(YIOS%NPROC),IOPENED(YIOS%NPROC),IRECVCOUNTS(YIOS%NPROC)
INTEGER(KIND=JPIM) :: JROC
REAL(KIND=JPRB)    :: ZWALL_ALL(YIOS%NPROC),ZDAT(JPLENM),ZBUF(JPLENM*YIOS%NPROC)
REAL(KIND=JPRB)    :: ZWALL_OUT(YIOS%NPROC),ZWALL_IN(YIOS%NPROC)
REAL(KIND=JPRB)    :: ZTOTWALL_OUT(YIOS%NPROC),ZTOTWALL_IN(YIOS%NPROC)
INTEGER(KIND=JPIM) :: IRECS_OUT(YIOS%NPROC),IRECS_IN(YIOS%NPROC)
INTEGER(KIND=JPIB) :: IBYTES_OUT(YIOS%NPROC),IBYTES_IN(YIOS%NPROC)
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IOSTREAM_STATS',0,ZHOOK_HANDLE)

IOPEN       (YIOS%MYPROC) = NOPENIOSTREAMS
IOPENED     (YIOS%MYPROC) = NOPENEDIOSTREAMS
IRECS_IN    (YIOS%MYPROC) = NRECS_IN
IRECS_OUT   (YIOS%MYPROC) = NRECS_OUT
IBYTES_IN   (YIOS%MYPROC) = NBYTES_IN
IBYTES_OUT  (YIOS%MYPROC) = NBYTES_OUT
ZWALL_ALL   (YIOS%MYPROC) = TOTAL_WALLCLOCK
ZWALL_OUT   (YIOS%MYPROC) = WALLCLOCK_OUT
ZWALL_IN    (YIOS%MYPROC) = WALLCLOCK_IN
ZTOTWALL_OUT(YIOS%MYPROC) = TOTWALL_OUT
ZTOTWALL_IN (YIOS%MYPROC) = TOTWALL_IN

IF(YIOS%NPROC > 1) THEN
  ZDAT(1)  = IOPEN       (YIOS%MYPROC)
  ZDAT(2)  = IOPENED     (YIOS%MYPROC)
  ZDAT(3)  = IRECS_OUT   (YIOS%MYPROC)
  ZDAT(4)  = IRECS_IN    (YIOS%MYPROC)
  ZDAT(5)  = IBYTES_OUT  (YIOS%MYPROC)
  ZDAT(6)  = IBYTES_IN   (YIOS%MYPROC)
  ZDAT(7)  = ZWALL_ALL   (YIOS%MYPROC)
  ZDAT(8)  = ZWALL_OUT   (YIOS%MYPROC)
  ZDAT(9)  = ZWALL_IN    (YIOS%MYPROC)
  ZDAT(10) = ZTOTWALL_OUT(YIOS%MYPROC)
  ZDAT(11) = ZTOTWALL_IN (YIOS%MYPROC)
  IRECVCOUNTS(:) = JPLENM
  CALL GSTATS_BARRIER(729)
  CALL GSTATS(630,0)
  CALL MPL_GATHERV(ZDAT,KROOT=1,&
   & PRECVBUF=ZBUF,KRECVCOUNTS=IRECVCOUNTS, &
   & CDSTRING='IOSTREAM_MIX:IOSTREAM_STATS')
  CALL GSTATS(630,1)
  CALL GSTATS_BARRIER2(729)
  IF(YIOS%MYPROC == 1) THEN
    DO JROC=1,YIOS%NPROC
      IOPEN(JROC)   = ZBUF((JROC-1)*JPLENM+1)
      IOPENED(JROC) = ZBUF((JROC-1)*JPLENM+2)
      IRECS_OUT(JROC) = ZBUF((JROC-1)*JPLENM+3)
      IRECS_IN(JROC)  = ZBUF((JROC-1)*JPLENM+4)
      IBYTES_OUT(JROC) = ZBUF((JROC-1)*JPLENM+5)
      IBYTES_IN(JROC)  = ZBUF((JROC-1)*JPLENM+6)
      ZWALL_ALL(JROC) = ZBUF((JROC-1)*JPLENM+7)
      ZWALL_OUT(JROC) = ZBUF((JROC-1)*JPLENM+8)
      ZWALL_IN(JROC) = ZBUF((JROC-1)*JPLENM+9)
      ZTOTWALL_OUT(JROC) = ZBUF((JROC-1)*JPLENM+10)
      ZTOTWALL_IN(JROC) = ZBUF((JROC-1)*JPLENM+11)
    ENDDO
  ENDIF
ENDIF
IF(YIOS%MYPROC == 1) THEN
  WRITE(YIOS%NULOUT,'(4(A,I12))') 'IO-STREAM STATISTICS, TOTAL NO OF REC/BYTES READ ',&
   & SUM(IRECS_IN),'/',SUM(IBYTES_IN),' WRITTEN ',SUM(IRECS_OUT),'/',SUM(IBYTES_OUT)
   WRITE(YIOS%NULOUT,*) '-TASK-OPENED-OPEN-RECS IN -KBYTE IN    -RECS OUT-KBYTE OUT   &
    &-WALL   -WALL IN-WALL OU-TOT IN -TOT OUT'
  DO JROC=1,YIOS%NPROC
    WRITE(YIOS%NULOUT,'(I4,1X,I6,1X,I4,1X,I8,1X,I12,1X,I8,1X,I12,7(1x,f7.1))') &
     & JROC,IOPENED(JROC),IOPEN(JROC),IRECS_IN(JROC),IBYTES_IN(JROC)/1024,&
     & IRECS_OUT(JROC),IBYTES_OUT(JROC)/1024,ZWALL_ALL(JROC),ZWALL_IN(JROC),&
     & ZWALL_OUT(JROC),ZTOTWALL_IN(JROC),ZTOTWALL_OUT(JROC)
  ENDDO
  
ENDIF

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IOSTREAM_STATS',1,ZHOOK_HANDLE)
END SUBROUTINE IOSTREAM_STATS
!=============================================================
SUBROUTINE SETUP_IOREQUEST(YDR,CDTYPE,KGRIB3D,KLEVS3D,KGRIB2D,KLEVS2D,KBSET2D,KBSET3D,&
 & LDGRIB,KPROMA,CDLEVTYPE,LDFPDIST,LDINTERP,KTYPE_INTERP,LDISTRIBUTE,&
 & KGRIB_HANDLE,LDREADALL,LDLATLONG,LDINTONLY,KSMAX,LDRANDOM_ORDER,KCHUNKSIZE)

!**** *SETUP_IOREQUEST*  - Setup IO request

! Purpose - To initiate an io-request, select kind of data, etc.

! Explicit arguments :
! --------------------
! YDR          - IO request structure
! CDTYPE       - type of data ('RAW','SPECTRAL_FIELDS','GRIDPOINT_FIELDS')
! KGRIB3D      - GRIB parameter codes for 3-D data (points,levels and parameters)
! KLEVS3D      - level list for 3-D data
! KGRIB2D      - GRIB parameter codes for 2-D data
! KLEVS3D      - level list for 2-D data
! KBSET2D      - B-set for 2-D data(spectral only)
! LDGRIB       - TRUE if data in GRIB form
! KPROMA       - blocking size for gridpoint data
! CDLEVTYPE    - level type (model,pressure etc.)
! LDFPDIST     - Full-pos distribution of data
! LDINTERP     - data to be horizontally interpolated on read/write
! KTYPE_INTERP - interpolation method
! LDISTRIBUTE  - data to be distrubuted
! KGRIB_HANDLE - Grib header template handle
! LDREADALL    - read all file (do not stop whean request satisfied)
! LDLATLONG    - data is in lat/long format (not reduced grid)
! LDINTONLY    - request for interogating only

!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
CHARACTER(LEN=*)           ,INTENT(IN) :: CDTYPE
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB3D(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KLEVS3D(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB2D(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KLEVS2D(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KBSET2D(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KBSET3D(:)
LOGICAL           ,OPTIONAL,INTENT(IN) :: LDGRIB
LOGICAL           ,OPTIONAL,INTENT(IN) :: LDFPDIST
LOGICAL           ,OPTIONAL,INTENT(IN) :: LDINTERP
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTYPE_INTERP
LOGICAL           ,OPTIONAL,INTENT(IN) :: LDISTRIBUTE
LOGICAL           ,OPTIONAL,INTENT(IN) :: LDREADALL
LOGICAL           ,OPTIONAL,INTENT(IN) :: LDLATLONG
LOGICAL           ,OPTIONAL,INTENT(IN) :: LDINTONLY
LOGICAL           ,OPTIONAL,INTENT(IN) :: LDRANDOM_ORDER
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KPROMA
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KSMAX
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(IN) :: CDLEVTYPE
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB_HANDLE
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KCHUNKSIZE

REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: JLEV,ILEN,ISMAX,IPRTRW,IMYSETW,IMYSETV,ILOCLEV

INTERFACE
#include "ini_spec_dist.h"
END INTERFACE

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:SETUP_IOREQUEST',0,ZHOOK_HANDLE)

!Preset defaults
YDR%LGRIB         = .FALSE.
YDR%LRANDOM_ORDER = .FALSE.
YDR%LFPDIST       = .FALSE.
YDR%LINTERP       = .FALSE.
YDR%NTYPE_INTERP  = 0
YDR%LDISTRIBUTE   = .TRUE.
YDR%LGEOPRESET    = .FALSE.
YDR%LREADALL      = .FALSE.
YDR%LINQUIRE      = .FALSE.
YDR%LATLONG       = .FALSE.
YDR%LINTONLY      = .FALSE.
YDR%CLEVTYPE      = 'SFC'
YDR%NCHUNKSIZE    = 8
YDR%IGRIB_HANDLE  = -1

NULLIFY(YDR%ILEVS)
NULLIFY(YDR%IGRBCODES)
NULLIFY(YDR%IHAVEFLD)
NULLIFY(YDR%YMDL_3D%ILEVS)
NULLIFY(YDR%YMDL_3D%IGRIBCODE)
NULLIFY(YDR%YMDL_3D%IBSET)
NULLIFY(YDR%YMDL_3D%ILOCLEV)
NULLIFY(YDR%YMDL_2D%IGRIBCODE)
NULLIFY(YDR%YMDL_2D%ILEVS)
NULLIFY(YDR%YMDL_2D%IBSET)
NULLIFY(YDR%YMDL_2D%ILOCFLD)

! Set logical switches according to arguments
IF(PRESENT(LDGRIB))      YDR%LGRIB       = LDGRIB
IF(PRESENT(CDLEVTYPE))   YDR%CLEVTYPE    = CDLEVTYPE
IF(PRESENT(LDFPDIST))    YDR%LFPDIST     = LDFPDIST
IF(PRESENT(LDINTERP))    THEN
  IF(LDINTERP .AND. .NOT.YIOS%LIFS_INTERNAL) &
   & CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - LDINTERP=TRUE ONLY INSIDE IFS')
  YDR%LINTERP     = LDINTERP 
ENDIF
IF(PRESENT(LDISTRIBUTE)) YDR%LDISTRIBUTE = LDISTRIBUTE
IF(PRESENT(LDREADALL))   YDR%LREADALL    = LDREADALL
IF(PRESENT(LDLATLONG))   YDR%LATLONG     = LDLATLONG
IF(PRESENT(LDINTONLY))   YDR%LINTONLY    = LDINTONLY

IF(YDR%LGRIB)  YDR%LRANDOM_ORDER = .TRUE.
IF(PRESENT(LDRANDOM_ORDER))   YDR%LRANDOM_ORDER   = LDRANDOM_ORDER

IF(PRESENT(KTYPE_INTERP)) YDR%NTYPE_INTERP = KTYPE_INTERP

ISMAX = YIOS%NSMAX
IF(PRESENT(KSMAX)) ISMAX = KSMAX
IF(PRESENT(KCHUNKSIZE)) YDR%NCHUNKSIZE = KCHUNKSIZE

IF(YDR%NCHUNKSIZE > JPMAXCHUNK) &
 & CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST -NCHUNKSIZE > JPMAXCHUNK')
!Set data type and dependent varaibles
SELECT CASE(CDTYPE)
CASE('RAW')
  YDR%IDATA_TYPE = JPRAW
CASE('SPECTRAL_FIELDS')
  YDR%IDATA_TYPE = JPSPEC
  IF(.NOT. YDR%LINTONLY) THEN
    IF(YDR%LFPDIST) THEN
      IF(.NOT.ASSOCIATED(YIOS%NFPMAX)) CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - YIOS%NFPMAX NOT DEFINED')
      YDR%YSPF%ISMAX = YIOS%NFPMAX(1)
      YDR%YSPF%ISPEC2G=(YIOS%NFPMAX(1)+1)*(YIOS%NFPMAX(1)+2)
    ELSEIF(ISMAX /= YIOS%NSMAX) THEN
      YDR%YSPF%ISMAX = ISMAX
      YDR%YSPF%ISPEC2G = (ISMAX+1)*(ISMAX+2)
      CALL TRANS_INQ(KPRTRW=IPRTRW,KMYSETW=IMYSETW)
      CALL INI_SPEC_DIST(ISMAX,ISMAX,IPRTRW,IMYSETW,KSPEC2=YDR%YSPF%ISPEC2)
    ELSE
      YDR%YSPF%ISMAX = YIOS%NSMAX
      CALL TRANS_INQ(KSPEC2=YDR%YSPF%ISPEC2,KSPEC2G=YDR%YSPF%ISPEC2G)
    ENDIF
  ENDIF
CASE('GRIDPOINT_FIELDS')
  YDR%IDATA_TYPE = JPGP
  IF(YDR%LATLONG .OR. YDR%LINTONLY) THEN
    YDR%YGPF%IGPTOT = -99
    YDR%YGPF%IGPTOTG = -99
  ELSE
    IF(YDR%LFPDIST) THEN
      IF(YIOS%NFPRGPL == YIOS%NUNDEF) CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - YIOS%NFPRGPL NOT DEFINED')
      IF(YIOS%NFPRGPG == YIOS%NUNDEF) CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - YIOS%NFPRGPG NOT DEFINED')
      YDR%YGPF%IGPTOT = YIOS%NFPRGPL
      YDR%YGPF%IGPTOTG = YIOS%NFPRGPG
    ELSE
      CALL TRANS_INQ(KGPTOT=YDR%YGPF%IGPTOT,KGPTOTG=YDR%YGPF%IGPTOTG)
    ENDIF
  ENDIF
  IF(PRESENT(KPROMA)) THEN
    YDR%YGPF%NPROMA=KPROMA
  ELSE
    YDR%YGPF%NPROMA=YDR%YGPF%IGPTOT
  ENDIF
CASE DEFAULT
  CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - UNKNOWN DATA TYPE')
END SELECT

! For spectral and gridpoint data optionally set parameter lists etc.
IF(YDR%IDATA_TYPE == JPSPEC .OR. YDR%IDATA_TYPE == JPGP) THEN
  IF(PRESENT(KGRIB3D)) THEN
    YDR%YMDL_3D%NUMFLDS = UBOUND(KGRIB3D,1)
    ALLOCATE(YDR%YMDL_3D%IGRIBCODE(YDR%YMDL_3D%NUMFLDS))
    YDR%YMDL_3D%IGRIBCODE(:) = KGRIB3D(:)
    IF(.NOT.PRESENT(KLEVS3D)) THEN
      WRITE(YIOS%NULOUT,*) &
       & 'IOSTREAM_MIX:SETUP_IOREQUEST - KLEVS3D MISSING, ASSUMING MODEL LEVELS'
      IF(YIOS%NFLEVG == YIOS%NUNDEF) &
       & CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - YIOS%NFLEVG NOT INITIALIZED')
      YDR%YMDL_3D%NLEVS = YIOS%NFLEVG
      ALLOCATE(YDR%YMDL_3D%ILEVS(YDR%YMDL_3D%NLEVS))
      DO JLEV=1,YDR%YMDL_3D%NLEVS
        YDR%YMDL_3D%ILEVS(JLEV) = JLEV
      ENDDO
    ELSE  
      YDR%YMDL_3D%NLEVS = UBOUND(KLEVS3D,1)
      ALLOCATE(YDR%YMDL_3D%ILEVS(YDR%YMDL_3D%NLEVS))
      YDR%YMDL_3D%ILEVS(:) = KLEVS3D(:)
    ENDIF
    IF(YDR%IDATA_TYPE == JPSPEC) THEN
      ALLOCATE(YDR%YMDL_3D%IBSET(YDR%YMDL_3D%NLEVS))
      ALLOCATE(YDR%YMDL_3D%ILOCLEV(YDR%YMDL_3D%NLEVS))
      YDR%YMDL_3D%ILOCLEV(:)=-HUGE(JLEV)
      IF(PRESENT(KBSET3D)) THEN
        IF(SIZE(KBSET3D) < YDR%YMDL_3D%NLEVS) &
         & CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - KBSET3D TOO SMALL')
        YDR%YMDL_3D%IBSET(:) = KBSET3D(1:YDR%YMDL_3D%NLEVS)
      ELSE
        IF(YDR%YMDL_3D%NLEVS /= YIOS%NFLEVG)  &
         & CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - KBSET3D REQUIRED')
        YDR%YMDL_3D%IBSET(:) = YIOS%NBSETLEV(:)
      ENDIF
      CALL TRANS_INQ(KMYSETV=IMYSETV)
      ILOCLEV=0
      DO JLEV=1,YDR%YMDL_3D%NLEVS
        IF(YDR%YMDL_3D%IBSET(JLEV) == IMYSETV) THEN
          ILOCLEV=ILOCLEV+1
          YDR%YMDL_3D%ILOCLEV(JLEV)=ILOCLEV
        ENDIF
      ENDDO
    ENDIF
  ELSE
    YDR%YMDL_3D%NUMFLDS = 0
    YDR%YMDL_3D%NLEVS = 0
  ENDIF

  IF(PRESENT(KGRIB2D)) THEN
    ILEN = UBOUND(KGRIB2D,1)
    YDR%YMDL_2D%NUMFLDS = ILEN
    ALLOCATE(YDR%YMDL_2D%IGRIBCODE(ILEN))
    YDR%YMDL_2D%IGRIBCODE(:) = KGRIB2D(:)
    ALLOCATE(YDR%YMDL_2D%ILEVS(ILEN))
    ALLOCATE(YDR%YMDL_2D%IBSET(ILEN))
    ALLOCATE(YDR%YMDL_2D%ILOCFLD(ILEN))
    YDR%YMDL_2D%ILOCFLD(:)=-HUGE(JLEV)
    IF(PRESENT(KLEVS2D)) THEN
      IF(SIZE(KLEVS2D) < ILEN) &
       & CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - KLEVS2D TOO SMALL')
      YDR%YMDL_2D%ILEVS(:) = KLEVS2D(1:ILEN)
    ELSE
      YDR%YMDL_2D%ILEVS(:)= 0
    ENDIF
    IF(YDR%CLEVTYPE == 'ML') THEN
      YDR%YMDL_2D%ILEVS(:)=MAX(YDR%YMDL_2D%ILEVS(:),1) ! Make sure "surface" model level fields are assigned
                                                       ! to level 1
    ENDIF
    IF(PRESENT(KBSET2D)) THEN
      IF(SIZE(KBSET2D) < ILEN) &
       & CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - KBSET2D TOO SMALL')
      YDR%YMDL_2D%IBSET(:) = KBSET2D(1:ILEN)
    ELSE
      IF(YIOS%NBSETSP == YIOS%NUNDEF) &
       &  CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - YIOS%NBSETSP NOT DEFINED')
      YDR%YMDL_2D%IBSET(:) = YIOS%NBSETSP
    ENDIF
    CALL TRANS_INQ(KMYSETV=IMYSETV)
    ILOCLEV=0
    DO JLEV=1,YDR%YMDL_2D%NUMFLDS
      IF(YDR%YMDL_2D%IBSET(JLEV) == IMYSETV) THEN
        ILOCLEV=ILOCLEV+1
        YDR%YMDL_2D%ILOCFLD(JLEV)=ILOCLEV
      ENDIF
    ENDDO
  ELSE
    YDR%YMDL_2D%NUMFLDS = 0
  ENDIF
ENDIF

! Set level type
SELECT CASE(YDR%CLEVTYPE)
CASE('ML')
  YDR%CLEVTYPE_FDB = 'm'
CASE('PL')
  YDR%CLEVTYPE_FDB = 'p'
CASE('PV')
  YDR%CLEVTYPE_FDB = 'v'
CASE('TH')
  YDR%CLEVTYPE_FDB = 't'
CASE('SFC')
  YDR%CLEVTYPE_FDB = 's'
CASE('OML')               !KPP
  YDR%CLEVTYPE_FDB = 'm'  !KPP
CASE DEFAULT
  CALL ABOR1('IOSTREAM_MIX:SETUP_IOREQUEST - UNKNOWN LEVEL TYPE')
END SELECT

! For data in GRIB format allocate(or clone) GRIB header struct.
IF(YDR%LGRIB)THEN
  IF(PRESENT(KGRIB_HANDLE)) THEN
    CALL IGRIB_CLONE(KGRIB_HANDLE,YDR%IGRIB_HANDLE)
    YDR%LGEOPRESET = .TRUE.
  ENDIF
 !  IF(YDR%YGRBH%NSEC1(1) == 210 .AND. (YDR%YGRBH%NSEC1(6) == 185 .OR. &
 !  & YDR%YGRBH%NSEC1(6) == 182)) THEN
 !    YDR%YGRBH%NSEC1(23) = 18      ! scaling before coding (*1.e18)
 ! ENDIF
! YDR%YGRBH%RSEC3(2) = -9999. ! Set the value for missing data
!  IF(YDR%YGRBH%NSEC1(1) == 210 .AND. (YDR%YGRBH%NSEC1(6) == 52) .OR. &
!   & (YDR%YGRBH%NSEC1(6) == 53) .OR. (YDR%YGRBH%NSEC1(6) == 54) ) &
!   & YDR%YGRBH%NSEC1(5) = 192
ENDIF

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:SETUP_IOREQUEST',1,ZHOOK_HANDLE)
END SUBROUTINE SETUP_IOREQUEST

!=============================================================
SUBROUTINE CLOSE_IOREQUEST(YDR)
IMPLICIT NONE
!**** *CLOSE_IOREQUEST*  - Close IO request

! Purpose - Release space, reset defaults

! Explicit arguments :
! --------------------
! YDR        - IO request structure
!-------------------------------------------------------------------------
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:CLOSE_IOREQUEST',0,ZHOOK_HANDLE)
IF(ASSOCIATED(YDR%YMDL_3D%ILEVS))     DEALLOCATE(YDR%YMDL_3D%ILEVS)
IF(ASSOCIATED(YDR%YMDL_2D%ILEVS))     DEALLOCATE(YDR%YMDL_2D%ILEVS)
IF(ASSOCIATED(YDR%YMDL_3D%IBSET))     DEALLOCATE(YDR%YMDL_3D%IBSET)
IF(ASSOCIATED(YDR%YMDL_2D%IBSET))     DEALLOCATE(YDR%YMDL_2D%IBSET)
IF(ASSOCIATED(YDR%YMDL_3D%IGRIBCODE)) DEALLOCATE(YDR%YMDL_3D%IGRIBCODE)
IF(ASSOCIATED(YDR%YMDL_2D%IGRIBCODE)) DEALLOCATE(YDR%YMDL_2D%IGRIBCODE)
IF(ASSOCIATED(YDR%ILEVS)) DEALLOCATE(YDR%ILEVS)
IF(ASSOCIATED(YDR%IGRBCODES)) DEALLOCATE(YDR%IGRBCODES)
IF(ASSOCIATED(YDR%IHAVEFLD)) DEALLOCATE(YDR%IHAVEFLD)

IF(YDR%LGRIB)THEN
  YDR%LGRIB = .FALSE.
  IF(ALLOCATED(NGRIBD)) DEALLOCATE(NGRIBD)
  IF(ALLOCATED(NGSTA)) DEALLOCATE(NGSTA)
  IF(ALLOCATED(LGRIBDONE)) DEALLOCATE(LGRIBDONE)
  IF(ALLOCATED(NGRIBMSG)) DEALLOCATE(NGRIBMSG)
ENDIF
YDR%IDATA_TYPE = JPNONDEF 
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:CLOSE_IOREQUEST',1,ZHOOK_HANDLE)
END SUBROUTINE CLOSE_IOREQUEST

!=================================================================

SUBROUTINE IO_PUT(YD,YDR,PR1,PR2,PR3,PR4,KR1,KR2,KR3,KR4,CDR, &
                & KFLDPROC2D,KLEVPROC3D)

!**** *IO_PUT*  - Output(write) data

! Purpose - To write out data .

! Explicit arguments :
! --------------------
! YD   - IO stream structure
! YDR  - IO request structure
! PR1  - real rank 1 array
! PR2  - real rank 2 array
! PR3  - real rank 3 array
! PR4  - real rank 4 array
! KR1  - integer rank 1 array
! KR2  - integer rank 2 array
! KR3  - integer rank 3 array
! KR4  - integer rank 4 array
! CDR  - character string
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM) ,INTENT(INOUT) :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN) :: PR1(:)
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN) :: PR2(:,:)
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN) :: PR3(:,:,:)
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN) :: PR4(:,:,:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KR1(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KR2(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KR3(:,:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KR4(:,:,:,:)
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(IN) :: CDR
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPROC2D(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KLEVPROC3D(:)

INTEGER(KIND=JPIM) :: IPRD(4,4),IKRD(4,4),ISIZE
LOGICAL :: LLPR(4),LLKR(4)
INTEGER(KIND=JPIM),ALLOCATABLE :: IREC1(:)
REAL(KIND=JPRB)   ,ALLOCATABLE :: ZREC1(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB)    :: ZTIME0,ZTIME1

!-------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IO_PUT',0,ZHOOK_HANDLE)
CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)

IF(YD%NUMIOPROCS < 1 .OR. YD%NUMIOPROCS > YIOS%NPROC) THEN
  WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX-IO_PUT YD%NUMIOPROCS=',YD%NUMIOPROCS
  CALL ABOR1('IOSTREAM_MIX-IO_PUT IOSTREAM_MIX NOT SET UP')
ENDIF
! Check out optional arguments
CALL GET_PUT_ARGS(YDR,LLPR,IPRD,LLKR,IKRD,&
 & PR1,PR2,PR3,PR4,KR1,KR2,KR3,KR4)

IF(YDR%LGRIB) THEN
  IF(YDR%LGEOPRESET) THEN
    IF(YDR%IGRIB_HANDLE < 0 ) &
     & CALL ABOR1('IOSTREAM_MIX:IO_PUT - GRIB HANDLE NOT DEFINED')
  ELSE
    IF(.NOT. YIOS%LIFS_INTERNAL) CALL ABOR1('IOSTREAM_MIX:IO_PUT - GRIB HANDLE NOT DEFINED, NOT IFS')
    YDR%IGRIB_HANDLE=-1
    IF(YDR%IDATA_TYPE == JPSPEC) THEN
      IF(YDR%CLEVTYPE == 'ML') THEN
        IF(NGRIB_HANDLE_SH_ML < 0) CALL ABOR1('IOSTREAM_MIX:IO_PUT - NGRIB_HANDLE_SH_ML NOT SET UP')
        CALL IGRIB_CLONE(NGRIB_HANDLE_SH_ML,YDR%IGRIB_HANDLE)
      ELSE
        IF(NGRIB_HANDLE_SH < 0) CALL ABOR1('IOSTREAM_MIX:IO_PUT - NGRIB_HANDLE_SH NOT SET UP')
        CALL IGRIB_CLONE(NGRIB_HANDLE_SH,YDR%IGRIB_HANDLE)
      ENDIF
    ELSEIF(YDR%IDATA_TYPE == JPGP) THEN
      IF(YDR%CLEVTYPE == 'ML') THEN
        IF(NGRIB_HANDLE_GG_ML < 0) CALL ABOR1('IOSTREAM_MIX:IO_PUT - NGRIB_HANDLE_GG_ML NOT SET UP')
        CALL IGRIB_CLONE(NGRIB_HANDLE_GG_ML,YDR%IGRIB_HANDLE)
      ELSE
        IF(NGRIB_HANDLE_GG < 0) CALL ABOR1('IOSTREAM_MIX:IO_PUT - NGRIB_HANDLE_GG NOT SET UP')
        CALL IGRIB_CLONE(NGRIB_HANDLE_GG,YDR%IGRIB_HANDLE)
      ENDIF
    ENDIF
  ENDIF
ENDIF

SELECT CASE(YDR%IDATA_TYPE)
! Write raw (unstructured) data
CASE(JPRAW)
  IF(YD%LIOPROC) THEN
    IF(LLPR(1)) THEN
      CALL WRITE_RECORD(YD,YDR,1,PREC1=PR1)
    ENDIF
    IF(LLPR(2)) THEN
      ISIZE = SIZE(PR2)
      ALLOCATE(ZREC1(ISIZE))
      ZREC1(:) = RESHAPE(PR2,(/ISIZE/))
      CALL WRITE_RECORD(YD,YDR,1,PREC1=ZREC1)
      DEALLOCATE(ZREC1)
    ENDIF
    IF(LLPR(3)) THEN
      ISIZE = SIZE(PR3)
      ALLOCATE(ZREC1(ISIZE))
      ZREC1(:) = RESHAPE(PR3,(/ISIZE/))
      CALL WRITE_RECORD(YD,YDR,1,PREC1=ZREC1)
      DEALLOCATE(ZREC1)
    ENDIF
    IF(LLPR(4)) THEN
      ISIZE = SIZE(PR4)
      ALLOCATE(ZREC1(ISIZE))
      ZREC1(:) = RESHAPE(PR4,(/ISIZE/))
      CALL WRITE_RECORD(YD,YDR,1,PREC1=ZREC1)
      DEALLOCATE(ZREC1)
    ENDIF
    IF(LLKR(1)) THEN
      CALL WRITE_RECORD(YD,YDR,1,KREC1=KR1)
    ENDIF
    IF(LLKR(2)) THEN
      ISIZE = SIZE(KR2)
      ALLOCATE(IREC1(ISIZE))
      IREC1(:) = RESHAPE(KR2,(/ISIZE/))
      CALL WRITE_RECORD(YD,YDR,1,KREC1=IREC1)
      DEALLOCATE(IREC1)
    ENDIF
    IF(LLKR(3)) THEN
      ISIZE = SIZE(KR3)
      ALLOCATE(IREC1(ISIZE))
      IREC1(:) = RESHAPE(KR3,(/ISIZE/))
      CALL WRITE_RECORD(YD,YDR,1,KREC1=IREC1)
      DEALLOCATE(IREC1)
    ENDIF
    IF(LLKR(4)) THEN
      ISIZE = SIZE(KR4)
      ALLOCATE(IREC1(ISIZE))
      IREC1(:) = RESHAPE(KR4,(/ISIZE/))
      CALL WRITE_RECORD(YD,YDR,1,KREC1=IREC1)
      DEALLOCATE(IREC1)
    ENDIF
    IF (PRESENT(CDR)) THEN
      CALL WRITE_RECORD(YD,YDR,1,CDREC=CDR)
    ENDIF
  ENDIF
CASE(JPSPEC)
!Write out spectral fields
  CALL SPEC_OUT(YD,YDR,PR2,PR3,YDR%YMDL_2D%NUMFLDS,YDR%YMDL_3D%NLEVS,IPRD(3,3))
CASE(JPGP)
!Write out grid-point fields
  CALL GRID_OUT(YD,YDR,PR3,PR4,IPRD(3,2),IPRD(4,2),IPRD(4,3),KFLDPROC2D)
END SELECT

CALL IGRIB_RELEASE(YDR%IGRIB_HANDLE)

CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
YD%TOTWALL = YD%TOTWALL+(ZTIME1-ZTIME0)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IO_PUT',1,ZHOOK_HANDLE)

END SUBROUTINE IO_PUT
!=============================================================
SUBROUTINE IO_INQUIRE(YD,YDR,LDREAD,&
 & KPARAMS,KNLEVS,KNVARS,KSMAX,KLATS,KLONS,PLATS,&
 & KDATE,KTIME,KSTEP,KLEVTYP,KFLEV,PVALH,PVBH,PA,PB,KLEVS,&
 & KSVCOMP,KRITZ1,KRITZ2,KNUMB,KGRIB_HANDLE)

!**** *IO_INQUIRE*  - Find out contents of file

! Purpose - To return certain characteristics of data in a (GRIB)file

! Explicit arguments :
! --------------------
! YD      - IO stream structure
! YDR     - IO request structure
! LDREAD  - read in record (default true)
! KPARAMS - GRIB parameter numbers
! KSMAX   - spectral truncation
!! CDREPRT  - representation type (spectral, gridpoint)
! KLATS   - number of latitude rows
! KLONS   - number of points on each latitude row
! PLATS   - latitude of each row [radians]
! KDATE   - date of data (yyyymmdd)
! KTIME   - time of data (seconds)
! KSTEP   - current fc time (seconds)
! KLEVTYP - level type (model,pressure....)
! PA, PB  - pressure on level is given by p = PA + ps*PB where ps is
!           surface pressure
! KLEVS   - generalized "levels"
! KGRIB_HANDLE   - handle to GRIB_API field
!-------------------------------------------------------------------------

IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT)  :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
LOGICAL,OPTIONAL,INTENT(IN) :: LDREAD
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPARAMS(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KNLEVS(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KNVARS
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSMAX
!CHARACTER(LEN=*)  ,OPTIONAL,INTENT(OUT) :: CDREPRT
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KLATS
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KLONS(:)
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PLATS(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KDATE
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KTIME
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSTEP
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KLEVTYP
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KFLEV
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSVCOMP
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KRITZ1
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KRITZ2
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KNUMB
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PVALH(0:)
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PVBH (0:)
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PA(:,:)
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PB(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KLEVS(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KGRIB_HANDLE

INTEGER(KIND=JPIM) :: IPARAMS,IFF,IMAXPARAMS,IMAXNLEVS,IPARAM
INTEGER(KIND=JPIM) :: JVAR, IRET, JLEV,ILEV,ITAG,IGRIB_LEN,ILENINT
INTEGER(KIND=JPIM) :: IBUF(14)
REAL   (KIND=JPRB) :: ZA,ZB
INTEGER(KIND=JPIM),ALLOCATABLE :: INLEVS(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: IRANK(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: INDEX(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: ILEVS(:)
REAL   (KIND=JPRB),ALLOCATABLE :: ZREC(:,:)
REAL   (KIND=JPRB),ALLOCATABLE :: ZPRES(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: IGRIBMSG(:)
LOGICAL :: LLFIRST,LLREAD
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
REAL(KIND=JPRB)    :: ZTIME0,ZTIME1

!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IO_INQUIRE',0,ZHOOK_HANDLE)
CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)

IF(YD%NUMIOPROCS < 1 .OR. YD%NUMIOPROCS > YIOS%NPROC) THEN
  WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX-IO_INQUIRE YD%NUMIOPROCS=',YD%NUMIOPROCS
  CALL ABOR1('IOSTREAM_MIX-IO_INQUIRE IOSTREAM_MIX NOT SET UP')
ENDIF
IF(.NOT. YDR%LGRIB) CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - REQUIRES GRIB FILE')
YDR%LINQUIRE = .TRUE.
LLREAD = .TRUE.
IF(PRESENT(LDREAD)) LLREAD = LDREAD

IF(YD%LIOPROC) THEN
  
  IPARAMS=0
  IF(PRESENT(KPARAMS)) THEN
    IMAXPARAMS=SIZE(KPARAMS)
  ELSE
    IMAXPARAMS=0
  ENDIF
  IF(PRESENT(KNLEVS)) THEN
    IF(SIZE(KNLEVS) /= IMAXPARAMS) &
     &CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - SIZE(KNLEVS) /= IMAXPARAMS')
  ENDIF
  IF(PRESENT(PA)) THEN
    IF(.NOT.PRESENT(PB)) &
     & CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - PA BUT NOT PB PRESENT') 
    IMAXNLEVS = SIZE(PA(:,1))
    IF(SIZE(PB(:,1)) /= IMAXNLEVS) &
     & CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - SIZE(PB(:,1)) /= IMAXNLEVS')
    IF(SIZE(PA(1,:)) /= IMAXPARAMS) &
     & CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - SIZE(PA(1,:)) /= IMAXPARAMS')
    IF(SIZE(PB(1,:)) /= IMAXPARAMS) &
     & CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - SIZE(PB(1,:)) /= IMAXPARAMS')
  ENDIF
  IF(PRESENT(KLEVS)) THEN
    IF(SIZE(KLEVS(1,:)) /= IMAXPARAMS) &
     & CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - SIZE(KLEVS(1,:)) /= IMAXPARAMS')
  ENDIF
   
  IF(PRESENT(PA) .OR. PRESENT(KLEVS)) THEN
    ALLOCATE(INLEVS(IMAXPARAMS))
    INLEVS(:) = 0
  ENDIF

  LLFIRST = .TRUE.

  ALLOCATE(ZREC(YIOS%IMAXGRID,1))
  ALLOCATE(YDR%IGRBCODES(1))
  ALLOCATE(YDR%IHAVEFLD(1))
  ALLOCATE(YDR%ILEVS(1))

  DO 
    IF(LLREAD) THEN
      CALL READ_RECORD(YD,YDR,1,PREC=ZREC)
      IF (YD%LEOF) EXIT
    ENDIF
    IF(LLFIRST) THEN
      CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KSMAX=KSMAX,&
       & KLATS=KLATS,KLONS=KLONS,PLATS=PLATS,&
       & KDATE=KDATE,KTIME=KTIME,KSTEP=KSTEP,KLEVTYP=KLEVTYP,&
       & KFLEV=KFLEV,PVALH=PVALH,PVBH=PVBH,&
       & KSVCOMP=KSVCOMP,KRITZ1=KRITZ1,KRITZ2=KRITZ2,KNUMB=KNUMB)
      IF(PRESENT(KGRIB_HANDLE)) THEN
        KGRIB_HANDLE = -99
        CALL IGRIB_CLONE(YDR%IGRIB_HANDLE,KGRIB_HANDLE)
      ENDIF
      LLFIRST = .FALSE.
    ENDIF
    IF(PRESENT(KPARAMS)) THEN
      CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KPARAM=IPARAM)
      IFF = IFIND(IPARAM,KPARAMS(1:IPARAMS))
      IF(IFF == 0) THEN
        IPARAMS = IPARAMS+1
        IFF = IPARAMS
        IF(IPARAMS > IMAXPARAMS) CALL ABOR1('IOSTREAM_MIX:KPARAMS TOO SMALL')
        KPARAMS(IPARAMS) = IPARAM
      ENDIF
    ELSE
      EXIT
    ENDIF

    IF(PRESENT(PA)) THEN
      CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,PA=ZA,PB=ZB)
      IF(IFINDR(ZA,PA(1:INLEVS(IFF),IFF)) == 0 .OR. &
       & IFINDR(ZB,PB(1:INLEVS(IFF),IFF)) == 0) THEN
        INLEVS(IFF) = INLEVS(IFF)+1
        IF(INLEVS(IFF) > IMAXNLEVS) &
         & CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - INLEVS(IFF) > IMAXNLEVS')
        PA(INLEVS(IFF),IFF) = ZA
        PB(INLEVS(IFF),IFF) = ZB
      ENDIF
    ENDIF
    IF(PRESENT(KLEVS)) THEN
      CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KLEV=ILEV)
      IF(IFIND(ILEV,KLEVS(1:INLEVS(IFF),IFF)) == 0) THEN
        IF(.NOT.PRESENT(PA)) INLEVS(IFF) = INLEVS(IFF)+1
        IF(INLEVS(IFF) > SIZE(KLEVS(:,1))) &
         & CALL ABOR1('IOSTREAM_MIX:IO_INQUIRE - INLEVS(IFF) > SIZE(KLEVS(:,1)')
        KLEVS(INLEVS(IFF),IFF) = ILEV
      ENDIF
    ENDIF
  ENDDO


  IF(PRESENT(KNLEVS)) THEN
    KNLEVS(1:IPARAMS) = INLEVS(1:IPARAMS)
  ENDIF
  IF(PRESENT(KNVARS)) KNVARS = IPARAMS

  IF(PRESENT(PA)) THEN
!        SORT PA AND PB IN ORDER OF INCREASING PRESSURE

    DO JVAR=1,IPARAMS
      ALLOCATE (ZPRES(INLEVS(JVAR)),IRANK(INLEVS(JVAR)),INDEX(INLEVS(JVAR)))
      ZPRES(1:INLEVS(JVAR)) = PA(1:INLEVS(JVAR),JVAR)+YIOS%SIPR*PB(1:INLEVS(JVAR),JVAR)
      
      CALL KEYSORT(IRET,ZPRES,INLEVS(JVAR),INDEX=INDEX,INIT=.TRUE.)
      CALL GET_RANK(INDEX, IRANK)
!      DO JLEV=1,INLEVS(JVAR)
!        IRANK(INDEX(JLEV)) = JLEV
!      ENDDO
      
      DO JLEV=1,INLEVS(JVAR)
        ZPRES(JLEV) = PA(IRANK(JLEV),JVAR)
      ENDDO
      PA(1:INLEVS(JVAR),JVAR) = ZPRES(:)
      
      DO JLEV=1,INLEVS(JVAR)
        ZPRES(JLEV) = PB(IRANK(JLEV),JVAR)
      ENDDO
      PB(1:INLEVS(JVAR),JVAR) = ZPRES(:)

      IF(PRESENT(KLEVS)) THEN
        ALLOCATE(ILEVS(INLEVS(JVAR)))
        DO JLEV=1,INLEVS(JVAR)
          ILEVS(JLEV) = KLEVS(IRANK(JLEV),JVAR)
        ENDDO
        KLEVS(1:INLEVS(JVAR),JVAR) = ILEVS(:)
        DEALLOCATE(ILEVS)
      ENDIF
      DEALLOCATE (ZPRES,IRANK,INDEX)
    ENDDO
    DEALLOCATE (INLEVS)
  ENDIF
  IF(ALLOCATED(ZREC)) DEALLOCATE(ZREC)
  DEALLOCATE(YDR%IGRBCODES)
  DEALLOCATE(YDR%IHAVEFLD)
  DEALLOCATE(YDR%ILEVS)
ENDIF
IF(YDR%LDISTRIBUTE) THEN
  CALL GSTATS_BARRIER(707)
  CALL GSTATS(628,0)
  ITAG = 1000
  IF(PRESENT(KPARAMS)) CALL MPL_BROADCAST(KPARAMS,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(KNLEVS))  CALL MPL_BROADCAST(KNLEVS ,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(KLONS))   CALL MPL_BROADCAST(KLONS  ,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(KLEVS))   CALL MPL_BROADCAST(KLEVS  ,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(PLATS))   CALL MPL_BROADCAST(PLATS  ,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(PVALH))   CALL MPL_BROADCAST(PVALH  ,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(PVBH ))   CALL MPL_BROADCAST(PVBH   ,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(PA))      CALL MPL_BROADCAST(PA     ,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(PB))      CALL MPL_BROADCAST(PB     ,ITAG,YD%IOMASTER,&
   & CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(KNVARS))  IBUF(1) = KNVARS
  IF(PRESENT(KSMAX))   IBUF(2) = KSMAX
!  IF(PRESENT(KREPRT))  IBUF(3) = KREPRT
  IF(PRESENT(KLATS))   IBUF(4) = KLATS
  IF(PRESENT(KDATE))   IBUF(5) = KDATE
  IF(PRESENT(KTIME))   IBUF(6) = KTIME
  IF(PRESENT(KLEVTYP)) IBUF(7) = KLEVTYP
  IF(PRESENT(KFLEV))   IBUF(8) = KFLEV
  IF(PRESENT(KSTEP))   IBUF(9) = KSTEP
  IF(PRESENT(KSVCOMP)) IBUF(10) = KSVCOMP
  IF(PRESENT(KNUMB))   IBUF(11) = KNUMB
  IF(PRESENT(KRITZ1))  IBUF(12) = KRITZ1
  IF(PRESENT(KRITZ2))  IBUF(13) = KRITZ2
  CALL MPL_BROADCAST(IBUF,ITAG,YD%IOMASTER,CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
  IF(PRESENT(KNVARS))  KNVARS  = IBUF(1)
  IF(PRESENT(KSMAX))   KSMAX   = IBUF(2)
!  IF(PRESENT(KREPRT))  KREPRT  = IBUF(3)
  IF(PRESENT(KLATS))   KLATS   = IBUF(4)
  IF(PRESENT(KDATE))   KDATE   = IBUF(5)
  IF(PRESENT(KTIME))   KTIME   = IBUF(6)
  IF(PRESENT(KLEVTYP)) KLEVTYP = IBUF(7)
  IF(PRESENT(KFLEV))   KFLEV   = IBUF(8)
  IF(PRESENT(KSTEP))   KSTEP   = IBUF(9)
  IF(PRESENT(KSVCOMP)) KSVCOMP = IBUF(10)
  IF(PRESENT(KNUMB))   KNUMB   = IBUF(11)
  IF(PRESENT(KRITZ1))  KRITZ1  = IBUF(12)
  IF(PRESENT(KRITZ2))  KRITZ2 =  IBUF(13)
  CALL GSTATS(628,1)
  CALL GSTATS_BARRIER2(707)
  IF(PRESENT(KGRIB_HANDLE)) THEN
    IF(YIOS%MYPROC == YD%IOMASTER) THEN
      CALL IGRIB_GET_MESSAGE_SIZE(KGRIB_HANDLE,IGRIB_LEN)
      ILENINT = (IGRIB_LEN+YIOS%NINTLEN-1)/YIOS%NINTLEN
      ALLOCATE(IGRIBMSG(ILENINT))
      CALL IGRIB_GET_MESSAGE(KGRIB_HANDLE,IGRIBMSG)
    ENDIF
    CALL MPL_BROADCAST(ILENINT,ITAG,YD%IOMASTER,CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
    IF(YIOS%MYPROC /= YD%IOMASTER) ALLOCATE(IGRIBMSG(ILENINT))
    CALL MPL_BROADCAST(IGRIBMSG,ITAG,YD%IOMASTER,CDSTRING='IOSTREAM_MIX:IO_INQUIRE')
    IF(YIOS%MYPROC /= YD%IOMASTER) THEN
      CALL IGRIB_NEW_FROM_MESSAGE(KGRIB_HANDLE,IGRIBMSG)
    ENDIF
    DEALLOCATE(IGRIBMSG)
  ENDIF
ENDIF
YDR%LINQUIRE = .FALSE.
CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
YD%TOTWALL = YD%TOTWALL+(ZTIME1-ZTIME0)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IO_INQUIRE',1,ZHOOK_HANDLE)
END SUBROUTINE IO_INQUIRE
!=================================================================
SUBROUTINE SPEC_OUT(YD,YDR,PSPEC2,PSPEC3,KFLD2,KLEV,KFLD3)

!**** *SPEC_OUT*  - Outpout spectral data

! Purpose - Gather and write out spectral fields

! Explicit arguments :
! --------------------
! YD      - IO stream structure
! YDR     - IO request structure
! PSPEC2  - 2-D spectral fields
! PSPEC3  - 3-D spectral fields
! KFLD2   - number of 2-D spectral fields
! KLEV    - number of levels in 3-D spectral fields 
! KFLD3   - number of 3-D spectral fields
!-------------------------------------------------------------------------

IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT) :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PSPEC2(:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PSPEC3(:,:,:)
INTEGER(KIND=JPIM),INTENT(IN) :: KFLD2,KLEV,KFLD3

INTEGER(KIND=JPIM) :: ITO2(KFLD2),IBSET2(KFLD2) 
INTEGER(KIND=JPIM) :: ITO3(KLEV),IBSET3(KLEV) 
INTEGER(KIND=JPIM) :: ISPEC2G,JFLD,JLEV,IMYCOUNT,IRET,IFLD,ILEV,JS,IHELP,IMYSETV
INTEGER(KIND=JPIM) :: ICHUNKSZ, IFI, ILA, IFLDS, IMYFLDS, JJFLD,ILFI,ILLA,JJ
INTEGER(KIND=JPIM) :: ILPT,ILPT2(KFLD2),ILPT3(KLEV)
LOGICAL :: LL2B(KFLD2), LL3B(KLEV)
REAL(KIND=JPRB),ALLOCATABLE :: ZSPECG(:,:),ZSPEC(:,:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:SPEC_OUT',0,ZHOOK_HANDLE)
CALL TRANS_INQ(KMYSETV=IMYSETV)
IF( YD%IOTYPE == JPFDB ) THEN
  IRET = ISETVALFDBSUBS(YD%IFILE_HANDLE,'repr','sh')
  IRET = ISETVALFDBSUBS(YD%IFILE_HANDLE,'levt',YDR%CLEVTYPE_FDB)
ENDIF
ISPEC2G = YDR%YSPF%ISPEC2G

IF(KFLD2 > 0) THEN
  IBSET2(:) = YDR%YMDL_2D%IBSET(:)
  LL2B(:) = .FALSE.
  ILPT = 0
  DO JJ=1,KFLD2
    IF(IBSET2(JJ) == IMYSETV) THEN
      ILPT = ILPT+1
      LL2B(JJ) = .TRUE. 
    ENDIF
    ILPT2(JJ) = ILPT
  ENDDO
  IF(YD%NUMIOPROCS > 1) THEN
    YD%LIOUSEHELP=.FALSE.
    CALL ASSIGN_IOPROC(YD,ITO2,IMYCOUNT)
    ICHUNKSZ = KFLD2
    ALLOCATE(ZSPECG(YDR%YSPF%ISPEC2G,IMYCOUNT))
    ALLOCATE(YDR%IGRBCODES(IMYCOUNT))
    ALLOCATE(YDR%ILEVS(IMYCOUNT))
    ALLOCATE(YDR%IHAVEFLD(KFLD2))
  ELSE
    IF(YDR%LDISTRIBUTE) THEN
      YD%LIOUSEHELP = .NOT.YD%LIONOHELP
    ELSE
      YD%LIOUSEHELP = .FALSE.
      ITO2(:) = YD%IOPROCS(1)
    ENDIF
    IF(YD%NUMHLP(1) == 1) THEN
      ICHUNKSZ = YDR%NCHUNKSIZE
    ELSE
      ICHUNKSZ = KFLD2
    ENDIF
    IF(YD%LIOPROC) THEN
      IMYCOUNT = KFLD2
    ELSE
      IMYCOUNT = 0
    ENDIF
    IHELP=YD%NUMHLP(1)-1
    IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
      ALLOCATE(ZSPECG(YDR%YSPF%ISPEC2G,ICHUNKSZ/MAX(1,IHELP)+1))
    ELSE
      ALLOCATE(ZSPECG(1,1))
    ENDIF
    ALLOCATE(YDR%IGRBCODES(ICHUNKSZ))
    ALLOCATE(YDR%IHAVEFLD(ICHUNKSZ))
    ALLOCATE(YDR%ILEVS(ICHUNKSZ))
  ENDIF

  IF( YD%IOTYPE == JPFDB ) THEN
    IRET = ISETFIELDCOUNTFDBSUBS(YD%IFILE_HANDLE,KFLD2,IMYCOUNT)
    IF(IRET /= 0) THEN
      WRITE(YIOS%NULERR,'(A,I4)') ' ISETFIELDCOUNTFDB RETURNS ',IRET
      CALL ABOR1('IOSTREAM_MIX: ISETFIELDCOUNTFDB')
    ENDIF
  ENDIF
  DO JJFLD=1,KFLD2,ICHUNKSZ
    IFI = JJFLD
    ILA = MIN(JJFLD+ICHUNKSZ-1,KFLD2)
    ILLA = MAX(0,MAXVAL(ILPT2(IFI:ILA),MASK=LL2B(IFI:ILA)))
    ILFI = MIN(ILLA,MINVAL(ILPT2(IFI:ILA),MASK=LL2B(IFI:ILA)))
    IFLDS = ILA-IFI+1
    DO JFLD=1,IFLDS
      IF(YD%LIOUSEHELP) THEN
        YDR%IHAVEFLD(JFLD)=IGETPROCHLP(YD,JFLD)
      ELSE
        YDR%IHAVEFLD(JFLD)=ITO2(IFI+JFLD-1)
      ENDIF
    ENDDO
    IF(YD%NUMIOPROCS > 1) THEN
      IMYFLDS = IMYCOUNT
    ELSEIF(YD%LIOPROC) THEN
      IMYFLDS = IFLDS
    ELSE
      IMYFLDS = 0
    ENDIF
    IF(YDR%LDISTRIBUTE) THEN
      IF(ILLA >0) THEN
        CALL GATH_SPEC(PSPECG=ZSPECG,KFGATHG=IFLDS,KTO=YDR%IHAVEFLD(1:IFLDS),&
         & KVSET=IBSET2(IFI:ILA),PSPEC=PSPEC2(:,ILFI:ILLA),&
         & LDIM1_IS_FLD=.FALSE.,KSMAX=YDR%YSPF%ISMAX)
      ELSE
        CALL GATH_SPEC(PSPECG=ZSPECG,KFGATHG=IFLDS,KTO=YDR%IHAVEFLD(1:IFLDS),&
         & KVSET=IBSET2(IFI:ILA),&
         & LDIM1_IS_FLD=.FALSE.,KSMAX=YDR%YSPF%ISMAX)
      ENDIF
    ENDIF
    IFLD = 0
    DO JFLD=IFI,ILA
      IF(YDR%IHAVEFLD(JFLD-IFI+1) == YIOS%MYPROC) THEN
        IFLD = IFLD+1
        YDR%IGRBCODES(IFLD) = YDR%YMDL_2D%IGRIBCODE(JFLD)
        YDR%ILEVS(IFLD) = YDR%YMDL_2D%ILEVS(JFLD)
      ENDIF
    ENDDO
      IF(YDR%LDISTRIBUTE) THEN
      IF(YD%LIOUSEHELP) THEN
        IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
          CALL WRITE_RECORD(YD,YDR,IFLDS,PREC=ZSPECG)
        ENDIF
      ELSE
        IF(IMYFLDS > 0) THEN
        CALL WRITE_RECORD(YD,YDR,IMYFLDS,PREC=ZSPECG)
      ENDIF
      ENDIF
      ELSE
      IF(IMYFLDS > 0) THEN
        CALL WRITE_RECORD(YD,YDR,IMYFLDS,PREC=PSPEC2(:,IFI:ILA))
      ENDIF
    ENDIF
  ENDDO
  IF(ALLOCATED(ZSPECG)) DEALLOCATE(ZSPECG)
  DEALLOCATE(YDR%IGRBCODES)
  DEALLOCATE(YDR%IHAVEFLD)
  DEALLOCATE(YDR%ILEVS)
ENDIF

IF(YDR%YMDL_3D%NUMFLDS > 0) THEN
  IBSET3(:) = YDR%YMDL_3D%IBSET(:)
  LL3B(:) = .FALSE.
  ILPT = 0
  DO JJ=1,KLEV
    IF(IBSET3(JJ) == IMYSETV) THEN
      ILPT = ILPT+1
      LL3B(JJ) = .TRUE.
    ENDIF
    ILPT3(JJ) = ILPT
  ENDDO
  IF(YD%NUMIOPROCS > 1) THEN
    YD%LIOUSEHELP = .FALSE.
    CALL ASSIGN_IOPROC(YD,ITO3,IMYCOUNT)
    ICHUNKSZ = KLEV
    ALLOCATE(ZSPECG(YDR%YSPF%ISPEC2G,IMYCOUNT))
    ALLOCATE(YDR%IGRBCODES(IMYCOUNT))
    ALLOCATE(YDR%IHAVEFLD(KLEV))
    ALLOCATE(YDR%ILEVS(IMYCOUNT))
  ELSE
    ITO3(:) = YD%IOPROCS(1)
    YD%LIOUSEHELP = .NOT.YD%LIONOHELP
    IF(YD%NUMHLP(1) == 1) THEN
      ICHUNKSZ = YDR%NCHUNKSIZE
    ELSE
      ICHUNKSZ = KLEV
    ENDIF
    IF(YD%IOPROCS(1) == YIOS%MYPROC) THEN
      IMYCOUNT = KLEV
    ELSE
      IMYCOUNT = 0
    ENDIF
    IHELP=YD%NUMHLP(1)-1
    IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
      ALLOCATE(ZSPECG(YDR%YSPF%ISPEC2G,ICHUNKSZ/MAX(1,IHELP)+1))
    ELSE
      ALLOCATE(ZSPECG(1,1))
    ENDIF
    ALLOCATE(YDR%IGRBCODES(ICHUNKSZ))
    ALLOCATE(YDR%IHAVEFLD(ICHUNKSZ))
    ALLOCATE(YDR%ILEVS(ICHUNKSZ))
  ENDIF
  ALLOCATE(ZSPEC(YDR%YSPF%ISPEC2,SIZE(PSPEC3,1)))

  DO JFLD=1,YDR%YMDL_3D%NUMFLDS
    IF( YD%IOTYPE == JPFDB ) THEN
      IRET = ISETFIELDCOUNTFDBSUBS(YD%IFILE_HANDLE,YDR%YMDL_3D%NLEVS,IMYCOUNT)
    ENDIF
    DO JJFLD=1,KLEV,ICHUNKSZ
      IFI = JJFLD
      ILA = MIN(JJFLD+ICHUNKSZ-1,KLEV)
      ILLA = MAX(0,MAXVAL(ILPT3(IFI:ILA),MASK=LL3B(IFI:ILA)))
      ILFI = MIN(ILLA,MINVAL(ILPT3(IFI:ILA),MASK=LL3B(IFI:ILA)))
      IFLDS = ILA-IFI+1
      IF(YD%LIOUSEHELP) THEN
        DO JLEV=1,IFLDS
          YDR%IHAVEFLD(JLEV)=IGETPROCHLP(YD,JLEV)
        ENDDO
      ENDIF
      DO JLEV=1,IFLDS
        IF(YD%LIOUSEHELP) THEN
          YDR%IHAVEFLD(JLEV)=IGETPROCHLP(YD,JLEV)
        ELSE
          YDR%IHAVEFLD(JLEV)=ITO3(IFI+JLEV-1)
        ENDIF
      ENDDO
      IF(YD%NUMIOPROCS > 1) THEN
        IMYFLDS = IMYCOUNT
      ELSEIF(YD%IOPROCS(1) == YIOS%MYPROC) THEN
        IMYFLDS = IFLDS
      ELSE
        IMYFLDS = 0
      ENDIF
      IF( SIZE(PSPEC3,1) > 0 )THEN
        CALL GSTATS(1479,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JLEV,ILEV,JS)
        DO JLEV=ILFI,ILLA
          ILEV = JLEV-ILFI+1
          DO JS=1,YDR%YSPF%ISPEC2
            ZSPEC(JS,ILEV) = PSPEC3(JLEV,JS,JFLD)
          ENDDO
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1479,1)
      ENDIF
      IF(YDR%LDISTRIBUTE) THEN
        CALL GATH_SPEC(PSPECG=ZSPECG,KFGATHG=IFLDS,KTO=YDR%IHAVEFLD(1:IFLDS),&
         & KVSET=IBSET3(IFI:ILA),PSPEC=ZSPEC,KSMAX=YDR%YSPF%ISMAX,&
         & LDIM1_IS_FLD=.FALSE.)
        IFLD = 0
        DO JLEV=IFI,ILA
          IF(YDR%IHAVEFLD(JLEV-IFI+1) == YIOS%MYPROC) THEN
            IFLD = IFLD+1
            YDR%IGRBCODES(IFLD) = YDR%YMDL_3D%IGRIBCODE(JFLD)
            YDR%ILEVS(IFLD) = YDR%YMDL_3D%ILEVS(JLEV)
          ENDIF
        ENDDO
        IF(YD%LIOUSEHELP) THEN
          IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
            CALL WRITE_RECORD(YD,YDR,IFLDS,PREC=ZSPECG)
          ENDIF
        ELSE
        IF(IMYFLDS > 0) THEN
          CALL WRITE_RECORD(YD,YDR,IMYFLDS,PREC=ZSPECG)
        ENDIF
        ENDIF
      ELSE
        IFLD = 0
        DO JLEV=IFI,ILA
          IF(ITO3(JLEV) == YIOS%MYPROC) THEN
            IFLD = IFLD+1
            YDR%IGRBCODES(1) = YDR%YMDL_3D%IGRIBCODE(JFLD)
            YDR%ILEVS(1) = YDR%YMDL_3D%ILEVS(JLEV)
            CALL WRITE_RECORD(YD,YDR,1,PREC=PSPEC3(IFLD,:,JFLD:JFLD))
          ENDIF
        ENDDO
      ENDIF
    ENDDO
  ENDDO
  IF(ALLOCATED(ZSPECG)) DEALLOCATE(ZSPECG)
  IF(ALLOCATED(ZSPEC)) DEALLOCATE(ZSPEC)
  DEALLOCATE(YDR%IGRBCODES)
  DEALLOCATE(YDR%IHAVEFLD)
  DEALLOCATE(YDR%ILEVS)
ENDIF

IF( YIOS%NPROC > 1) THEN
  CALL GSTATS(711,0)
  CALL MPL_BARRIER(CDSTRING='IOSTREAM_MIX:SPEC_OUT')
  CALL GSTATS(711,1)
ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:SPEC_OUT',1,ZHOOK_HANDLE)
  
END SUBROUTINE SPEC_OUT
!=================================================================
SUBROUTINE GRID_OUT(YD,YDR,PGRID2,PGRID3,KFLD2,KLEV,KFLD3,KFLDPROC2D)

!**** *GRID_OUT*  - Output grid-point data

! Purpose - Gather and write out grid-point fields

! Explicit arguments :
! --------------------
! YD      - IO stream structure
! YDR     - IO request structure
! PGRID2  - 2-D grid-point fields
! PGRID3  - 3-D grid-point fields
! KFLD2   - number of 2-D grid-point fields
! KLEV    - number of levels in 3-D grid-point fields 
! KFLD3   - number of 3-D grid-point fields
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT) :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGRID2(:,:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGRID3(:,:,:,:)
INTEGER(KIND=JPIM),INTENT(IN) :: KFLD2,KLEV,KFLD3
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPROC2D(:)

INTEGER(KIND=JPIM) :: ITO2(KFLD2)
INTEGER(KIND=JPIM) :: ITO3(KLEV)
INTEGER(KIND=JPIM) :: JFLD,JLEV,IMYCOUNT,IRET,IFLD
INTEGER(KIND=JPIM) :: ILATS,IGPTOTG
INTEGER(KIND=JPIM),ALLOCATABLE  :: ILONS(:)
INTEGER(KIND=JPIM) :: ICHUNKSZ, IFI, ILA, IFLDS, IMYFLDS, JJFLD,J3D
INTEGER(KIND=JPIM) :: IMYGATH,IHELP
REAL(KIND=JPRB),ALLOCATABLE :: ZLATS(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZGRIDG(:,:)
REAL(KIND=JPRB),ALLOCATABLE :: ZZGRIDG(:,:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRID_OUT',0,ZHOOK_HANDLE)

IF( YD%IOTYPE == JPFDB ) THEN
  IRET = ISETVALFDBSUBS(YD%IFILE_HANDLE,'repr','gg')
  IRET = ISETVALFDBSUBS(YD%IFILE_HANDLE,'levt',YDR%CLEVTYPE_FDB)
ENDIF

IGPTOTG = YDR%YGPF%IGPTOTG
IF(KFLD2 > 0) THEN
  IF(YD%NUMIOPROCS > 1) THEN
    YD%LIOUSEHELP = .FALSE.
    CALL ASSIGN_IOPROC(YD,ITO2,IMYCOUNT,KFLDPROC2D)
    ICHUNKSZ = KFLD2
    IMYGATH=IMYCOUNT
    ALLOCATE(ZGRIDG(IGPTOTG,IMYCOUNT))
    ALLOCATE(YDR%IGRBCODES(KFLD2))
    ALLOCATE(YDR%IHAVEFLD(KFLD2))
    ALLOCATE(YDR%ILEVS(KFLD2))
    YDR%IHAVEFLD(:)=ITO2(:)
  ELSE
    IF(YDR%LDISTRIBUTE) THEN
      YD%LIOUSEHELP = .NOT.YD%LIONOHELP
    ELSE
      YD%LIOUSEHELP = .FALSE.
      ITO2(:) = YD%IOPROCS(1)
    ENDIF
    IF(YD%NUMHLP(1) == 1) THEN
      ICHUNKSZ = YDR%NCHUNKSIZE
  ELSE
      ICHUNKSZ = KFLD2
    ENDIF
    ALLOCATE(YDR%IGRBCODES(ICHUNKSZ))
    ALLOCATE(YDR%IHAVEFLD(ICHUNKSZ))
    ALLOCATE(YDR%ILEVS(ICHUNKSZ))
    ITO2(:) = YD%IOPROCS(1)
    IF(YD%IOPROCS(1) == YIOS%MYPROC) THEN
      IMYCOUNT = KFLD2
    ELSE
      IMYCOUNT = 0
    ENDIF
!    CALL ASSIGN_IOPROC(YD,YDR%IHAVEFLD,IMYGATH,KFLDPROC2D)
    IHELP=YD%NUMHLP(1)-1
    IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
      ALLOCATE(ZGRIDG(IGPTOTG,ICHUNKSZ/MAX(1,IHELP)+1))
    ELSE
      ALLOCATE(ZGRIDG(1,1))
    ENDIF
  ENDIF
  IF( YD%IOTYPE == JPFDB ) THEN
    IRET = ISETFIELDCOUNTFDBSUBS(YD%IFILE_HANDLE,KFLD2,IMYCOUNT)
  ENDIF

  DO JJFLD=1,KFLD2,ICHUNKSZ
    IFI = JJFLD
    ILA = MIN(JJFLD+ICHUNKSZ-1,KFLD2)
    IFLDS = ILA-IFI+1
    DO JFLD=1,IFLDS
      IF(YD%LIOUSEHELP) THEN
        YDR%IHAVEFLD(JFLD)=IGETPROCHLP(YD,JFLD)
      ELSE
        YDR%IHAVEFLD(JFLD)=ITO2(IFI+JFLD-1)
      ENDIF
    ENDDO
    IF(YD%NUMIOPROCS > 1) THEN
      IMYFLDS = IMYCOUNT
    ELSEIF(YD%IOPROCS(1) == YIOS%MYPROC) THEN
      IMYFLDS = IFLDS
    ELSE
      IMYFLDS = 0
    ENDIF
    IF(YDR%LDISTRIBUTE) THEN
      IF(YDR%LFPDIST) THEN
        CALL GATH_GRID_FP(PGPG=ZGRIDG,KFGATHG=IFLDS,KTO=YDR%IHAVEFLD(1:IFLDS),&
         & PGP=PGRID2(:,IFI:ILA,:))
      ELSE
!        This is where it goes
        CALL GATH_GRID(PGPG=ZGRIDG,KFGATHG=IFLDS,KTO=YDR%IHAVEFLD(1:IFLDS),&
         & PGP=PGRID2(:,IFI:ILA,:),KPROMA=YDR%YGPF%NPROMA)
      ENDIF
    ELSEIF(YD%LIOPROC) THEN
      CALL COPYGP_LOC2GLOB(ZGRIDG,PGRID2(:,IFI:ILA,:),&
       & YDR%YGPF%NPROMA,IGPTOTG)
    ENDIF
    IFLD = 0
    DO JFLD=IFI,ILA
      IF(YDR%IHAVEFLD(JFLD-IFI+1) == YIOS%MYPROC) THEN
        IFLD = IFLD+1
        YDR%IGRBCODES(IFLD) = YDR%YMDL_2D%IGRIBCODE(JFLD)
        YDR%ILEVS(IFLD) = YDR%YMDL_2D%ILEVS(JFLD)
      ENDIF
    ENDDO

    IF(YDR%LINTERP) THEN
    ! Note order of statements, YDR%YGPF%IGPTOTG changes in call to INQUIRE_GRIB
      ALLOCATE(ZZGRIDG(IGPTOTG,IFLDS))
      IF(YIOS%NDGLG == YIOS%NUNDEF) CALL ABOR1('IOSTREAM_MIX:GRID_OUT YIOS%NDGLG NOT DEFINED')
      IF(.NOT.ASSOCIATED(YIOS%NLOENG))  CALL ABOR1('IOSTREAM_MIX:GRID_OUT YIOS%NLOENG NOT DEFINED')
      IF(.NOT.ASSOCIATED(YIOS%RLATIG))  CALL ABOR1('IOSTREAM_MIX:GRID_OUT YIOS%RLATIG NOT DEFINED')
      ALLOCATE(ILONS(YIOS%NDGLG))
      ALLOCATE(ZLATS(YIOS%NDGLG))
      CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KLATS=ILATS,KLONS=ILONS,PLATS=ZLATS,&
       & KPTS=YDR%YGPF%IGPTOTG)
      IFLD = 0
      DO JFLD=IFI,ILA
        IF(YDR%IHAVEFLD(JFLD-IFI+1) == YIOS%MYPROC) THEN
          IFLD = IFLD+1
          ZZGRIDG(:,IFLD) = ZGRIDG(:,IFLD)
          ZGRIDG(:,IFLD) = 0.0_JPRB
          CALL INTERP_GP(YDR%NTYPE_INTERP,YDR%IGRBCODES(IFLD),YDR%ILEVS(IFLD),&
         & YIOS%NDGLG,YIOS%NLOENG(1:YIOS%NDGLG),YIOS%RLATIG(1:YIOS%NDGLG),&
           & ILATS,ILONS(1:ILATS),ZLATS(1:ILATS), &
           & ZZGRIDG(:,IFLD),ZGRIDG(:,IFLD))
        ENDIF
      ENDDO
      DEALLOCATE(ZZGRIDG)
      DEALLOCATE(ILONS)
      DEALLOCATE(ZLATS)
    ENDIF
    IF(YD%LIOUSEHELP) THEN
      IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
        CALL WRITE_RECORD(YD,YDR,IFLDS,PREC=ZGRIDG)
      ENDIF
    ELSE
      IF(IMYFLDS > 0) THEN
      CALL WRITE_RECORD(YD,YDR,IMYFLDS,PREC=ZGRIDG)
    ENDIF
    ENDIF
      
!     & KALLFLDS=IFLDS,KIOFLDS=ITO2(IFI:ILA),KHAVEFLDS=YDR%IHAVEFLD(IFI:ILA))
  ENDDO
  IF(ALLOCATED(ZGRIDG))  DEALLOCATE(ZGRIDG)
  DEALLOCATE(YDR%IGRBCODES)
  DEALLOCATE(YDR%IHAVEFLD)
  DEALLOCATE(YDR%ILEVS)
ENDIF

IF(YDR%YMDL_3D%NUMFLDS > 0) THEN
  IF(YDR%LINTERP) &
   & CALL ABOR1('IOSTREAM_MIX:IO_PUT - COMBINATION 3-D FIELDS&
   &  AND LINTERP NOT SUPPORTED')
  IF(YD%NUMIOPROCS > 1) THEN
    YD%LIOUSEHELP = .FALSE.
    CALL ASSIGN_IOPROC(YD,ITO3,IMYCOUNT)
    ICHUNKSZ = KLEV
    ALLOCATE(ZGRIDG(YDR%YGPF%IGPTOTG,IMYCOUNT))
    ALLOCATE(YDR%IGRBCODES(IMYCOUNT))
    ALLOCATE(YDR%IHAVEFLD(IMYCOUNT))
    ALLOCATE(YDR%ILEVS(IMYCOUNT))
  ELSE
    IF(YDR%LDISTRIBUTE) THEN
      YD%LIOUSEHELP = .NOT.YD%LIONOHELP
    ELSE
      YD%LIOUSEHELP = .FALSE.
    ENDIF
    IF(YD%LIOUSEHELP) THEN
      IHELP=YD%NUMHLP(1)-1
      ICHUNKSZ=MIN(YD%NUMHLP(1)*YDR%NCHUNKSIZE,KLEV)
    ELSE
      IHELP=0
    ITO3(:) = YD%IOPROCS(1)
      ICHUNKSZ = YDR%NCHUNKSIZE
    ENDIF
    IF(YD%IOPROCS(1) == YIOS%MYPROC) THEN
      IMYCOUNT = KLEV
    ELSE
      IMYCOUNT = 0
    ENDIF
    IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
      ALLOCATE(ZGRIDG(IGPTOTG,ICHUNKSZ/MAX(1,IHELP)+1))
    ELSE
      ALLOCATE(ZGRIDG(1,1))
    ENDIF
    ALLOCATE(YDR%IGRBCODES(ICHUNKSZ))
    ALLOCATE(YDR%IHAVEFLD(ICHUNKSZ))
    ALLOCATE(YDR%ILEVS(ICHUNKSZ))
  ENDIF
  DO J3D=1,YDR%YMDL_3D%NUMFLDS
    IF( YD%IOTYPE == JPFDB ) THEN
      IRET = ISETFIELDCOUNTFDBSUBS(YD%IFILE_HANDLE,YDR%YMDL_3D%NLEVS,IMYCOUNT)
    ENDIF
    DO JJFLD=1,KLEV,ICHUNKSZ
      IFI = JJFLD
      ILA = MIN(JJFLD+ICHUNKSZ-1,KLEV)
      IFLDS = ILA-IFI+1
      DO JFLD=1,IFLDS
        IF(YD%LIOUSEHELP) THEN
          YDR%IHAVEFLD(JFLD)=IGETPROCHLP(YD,JFLD)
      ELSE
          YDR%IHAVEFLD(JFLD)=ITO3(IFI+JFLD-1)
      ENDIF
      ENDDO
      IF(YDR%LDISTRIBUTE) THEN
        IF(YDR%LFPDIST) THEN
          CALL GATH_GRID_FP(PGPG=ZGRIDG,KFGATHG=IFLDS,KTO=YDR%IHAVEFLD(1:IFLDS),&
           & PGP=PGRID3(:,IFI:ILA,J3D,:))
        ELSE
          CALL GATH_GRID(PGPG=ZGRIDG,KFGATHG=IFLDS,KTO=YDR%IHAVEFLD(1:IFLDS),&
           & PGP=PGRID3(:,IFI:ILA,J3D,:),KPROMA=YDR%YGPF%NPROMA)
        ENDIF
      ELSEIF(YD%LIOPROC) THEN
        CALL COPYGP_LOC2GLOB(ZGRIDG,PGRID3(:,IFI:ILA,J3D,:),&
         & YDR%YGPF%NPROMA,YDR%YGPF%IGPTOTG)
      ENDIF
      IFLD = 0
      DO JLEV=IFI,ILA
        IF(YDR%IHAVEFLD(JLEV-IFI+1) == YIOS%MYPROC) THEN
          IFLD = IFLD+1
          YDR%IGRBCODES(IFLD) = YDR%YMDL_3D%IGRIBCODE(J3D)
          YDR%ILEVS(IFLD) = YDR%YMDL_3D%ILEVS(JLEV)
        ENDIF
      ENDDO
      IF(YD%LIOUSEHELP) THEN
        IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
          CALL WRITE_RECORD(YD,YDR,IFLDS,PREC=ZGRIDG)
        ENDIF
      ELSE
        IF(YD%NUMIOPROCS > 1) THEN
          IMYFLDS = IMYCOUNT
        ELSEIF(YD%IOPROCS(1) == YIOS%MYPROC) THEN
          IMYFLDS = IFLDS
        ELSE
          IMYFLDS = 0
        ENDIF
      IF(IMYFLDS > 0) THEN
        CALL WRITE_RECORD(YD,YDR,IMYFLDS,PREC=ZGRIDG)
      ENDIF
      ENDIF
    ENDDO
  ENDDO
  DEALLOCATE(ZGRIDG)
  DEALLOCATE(YDR%IGRBCODES)
  DEALLOCATE(YDR%IHAVEFLD)
  DEALLOCATE(YDR%ILEVS)
ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRID_OUT',1,ZHOOK_HANDLE)
  
END SUBROUTINE GRID_OUT
!=================================================================
SUBROUTINE IO_GET(YD,YDR,PR1,PR2,PR3,PR4,KR1,KR2,KR3,KR4,CDR,&
 & LDMISSING_2D,LDMISSING_3D,KFLDPROC2D,KLEVPROC3D)

!**** *IO_GET*  - Input (read) data

! Purpose - To read in data .

! Explicit arguments :
! --------------------
! YD   - IO stream structure
! YDR  - IO request structure
! PR1  - real rank 1 array
! PR2  - real rank 2 array
! PR3  - real rank 3 array
! PR4  - real rank 4 array
! KR1  - integer rank 1 array
! KR2  - integer rank 2 array
! KR3  - integer rank 3 array
! KR4  - integer rank 4 array
! CDR  - character string
! LDMISSING_2D - missing 2-D fields (if not present abort will be called if field missing)
! LDMISSING_2D - missing 3-D fields (if not present abort will be called if field missing)
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT) :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PR1(:)
REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PR2(:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PR3(:,:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PR4(:,:,:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KR1(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KR2(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KR3(:,:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KR4(:,:,:,:)
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(INOUT) :: CDR
LOGICAL,OPTIONAL,INTENT(OUT) :: LDMISSING_2D(:)
LOGICAL,OPTIONAL,INTENT(OUT) :: LDMISSING_3D(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPROC2D(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KLEVPROC3D(:)

LOGICAL :: LLPR(4),LLKR(4)
INTEGER(KIND=JPIM) :: IPRD(4,4),IKRD(4,4),ISIZE
INTEGER(KIND=JPIM),ALLOCATABLE :: IREC1(:)
REAL(KIND=JPRB)   ,ALLOCATABLE :: ZREC1(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB)    :: ZTIME0,ZTIME1
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IO_GET',0,ZHOOK_HANDLE)
CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)

IF(YD%NUMIOPROCS < 1 .OR. YD%NUMIOPROCS > YIOS%NPROC) THEN
  WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX-IO_GET YD%NUMIOPROCS=',YD%NUMIOPROCS
  CALL ABOR1('IOSTREAM_MIX-IO_GET IOSTREAM_MIX NOT SET UP')
ENDIF

CALL GET_PUT_ARGS(YDR,LLPR,IPRD,LLKR,IKRD,&
 & PR1,PR2,PR3,PR4,KR1,KR2,KR3,KR4)

SELECT CASE(YDR%IDATA_TYPE)
CASE(JPRAW)
  IF(YD%LIOPROC) THEN
    IF(LLPR(1)) THEN
      CALL READ_RECORD(YD,YDR,1,PREC1=PR1)
    ENDIF
    IF(LLPR(2)) THEN
      ISIZE = SIZE(PR2)
      ALLOCATE(ZREC1(ISIZE))
      CALL READ_RECORD(YD,YDR,1,PREC1=ZREC1)
      PR2(:,:) = RESHAPE(ZREC1,SHAPE(PR2))
      DEALLOCATE(ZREC1)
    ENDIF
    IF(LLPR(3)) THEN
      ISIZE = SIZE(PR3)
      ALLOCATE(ZREC1(ISIZE))
      CALL READ_RECORD(YD,YDR,1,PREC1=ZREC1)
      PR3(:,:,:) = RESHAPE(ZREC1,SHAPE(PR3))
      DEALLOCATE(ZREC1)
    ENDIF
    IF(LLPR(4)) THEN
      ISIZE = SIZE(PR4)
      ALLOCATE(ZREC1(ISIZE))
      CALL READ_RECORD(YD,YDR,1,PREC1=ZREC1)
      PR4(:,:,:,:) = RESHAPE(ZREC1,SHAPE(PR4))
      DEALLOCATE(ZREC1)
    ENDIF
    IF(LLKR(1)) THEN
      CALL READ_RECORD(YD,YDR,1,KREC1=KR1)
    ENDIF
    IF(LLKR(2)) THEN
      ISIZE = SIZE(KR2)
      ALLOCATE(IREC1(ISIZE))
      CALL READ_RECORD(YD,YDR,1,KREC1=IREC1)
      KR2(:,:) = RESHAPE(IREC1,SHAPE(KR2))
      DEALLOCATE(IREC1)
    ENDIF
    IF(LLKR(3)) THEN
      ISIZE = SIZE(KR3)
      ALLOCATE(IREC1(ISIZE))
      CALL READ_RECORD(YD,YDR,1,KREC1=IREC1)
      KR3(:,:,:) = RESHAPE(IREC1,SHAPE(KR3))
      DEALLOCATE(IREC1)
    ENDIF
    IF(LLKR(4)) THEN
      ISIZE = SIZE(KR4)
      ALLOCATE(IREC1(ISIZE))
      CALL READ_RECORD(YD,YDR,1,KREC1=IREC1)
      KR4(:,:,:,:) = RESHAPE(IREC1,SHAPE(KR4))
      DEALLOCATE(IREC1)
    ENDIF
    IF (PRESENT(CDR)) THEN
      CALL READ_RECORD(YD,YDR,1,CDREC=CDR)
    ENDIF
  ENDIF
CASE(JPSPEC)
  CALL SPEC_IN(YD,YDR,PR2,PR3,YDR%YMDL_2D%NUMFLDS,YDR%YMDL_3D%NLEVS,IPRD(3,3),&
   & LDMISSING_2D,LDMISSING_3D,KFLDPROC2D,KLEVPROC3D)  
CASE(JPGP)
  CALL GRID_IN(YD,YDR,PR3,PR4,IPRD(3,2),IPRD(4,2),IPRD(4,3),&
   & LDMISSING_2D,LDMISSING_3D,KFLDPROC2D)
END SELECT
CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
YD%TOTWALL = YD%TOTWALL+(ZTIME1-ZTIME0)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IO_GET',1,ZHOOK_HANDLE)

END SUBROUTINE IO_GET
!=================================================================
SUBROUTINE SPEC_IN(YD,YDR,PSPEC2,PSPEC3,KFLD2,KLEV,KFLD3,&
 & LDMISSING_2D,LDMISSING_3D,KFLDPROC2D,KLEVPROC3D)

!**** *SPEC_IN*  - Input spectral data

! Purpose - Read and distribute spectral fields

! Explicit arguments :
! --------------------
! YD      - IO stream structure
! YDR     - IO request structure
! PSPEC2  - 2-D spectral fields
! PSPEC3  - 3-D spectral fields
! KFLD2   - number of 2-D spectral fields
! KLEV    - number of levels in 3-D spectral fields 
! KFLD3   - number of 3-D spectral fields
! LDMISSING_2D - missing 2-D fields 
! LDMISSING_2D - missing 3-D fields 
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT) :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSPEC2(:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSPEC3(:,:,:)
INTEGER(KIND=JPIM),INTENT(IN) :: KFLD2,KLEV,KFLD3
LOGICAL,OPTIONAL,INTENT(OUT) :: LDMISSING_2D(:)
LOGICAL,OPTIONAL,INTENT(OUT) :: LDMISSING_3D(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPROC2D(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KLEVPROC3D(:)

INTEGER(KIND=JPIM) :: IFROM2(KFLD2),IBSET2(KFLD2) 
INTEGER(KIND=JPIM) :: IFROM3(KLEV),IBSET3(KLEV) 
INTEGER(KIND=JPIM) :: ISPEC2G,JFLD,JLEV,IFF,ILEV,ILOCLV,IMISSING,&
 & IFLD,IMYCOUNT,II,IMISSINGX
INTEGER(KIND=JPIM) :: ICHUNKSZ,ICHUNK,IIFLD
INTEGER(KIND=JPIM),ALLOCATABLE :: IMSG(:)
INTEGER(KIND=JPIM) :: IFROM(JPMAXCHUNK),IBSET(KFLD3*KLEV+KFLD2),IHELP,IIFROM(JPMAXCHUNK)
INTEGER(KIND=JPIM) :: JJ,IMYGFLD,IFLDG
REAL(KIND=JPRB),ALLOCATABLE :: ZSPECG(:,:),ZSPEC(:,:),ZSPECGT(:,:,:)
LOGICAL :: LLMISSING2D(KFLD2),LLMISSING3D(KLEV,KFLD3),LLFAIL
LOGICAL :: LLMISSING2DX(KFLD2),LLMISSING3DX(KLEV,KFLD3)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!-------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:SPEC_IN',0,ZHOOK_HANDLE)

IF(YDR%LINTERP) THEN
  ISPEC2G=YIOS%IMAXSPEC2G
ELSE
  ISPEC2G=YDR%YSPF%ISPEC2G
ENDIF
IF(YDR%LRANDOM_ORDER) THEN
  IF(YD%NUMIOPROCS /= 1) &
   & CALL ABOR1('IOSTREAM_MIX:SPEC_IN - READING RANDOM FILE WITH > 1 IOPROCS')
  YD%LIOUSEHELP = .NOT.YD%LIONOHELP
  IF(YD%LIOUSEHELP) THEN
    IHELP=YD%NUMHLP(1)-1
  ELSE
    IHELP=0
  ENDIF
  IF(KFLD2 > 0) LLMISSING2D(:)   = .TRUE.
  IF(KFLD3 > 0) LLMISSING3D(:,:) = .TRUE.
  IF(KFLD2 > 0) LLMISSING2DX(:)   = .TRUE.
  IF(KFLD3 > 0) LLMISSING3DX(:,:) = .TRUE.
  IMISSING = KLEV*KFLD3+KFLD2
  IMISSINGX = KLEV*KFLD3+KFLD2
  ICHUNKSZ = YDR%NCHUNKSIZE*MAX(1,IHELP)
  ICHUNKSZ = MIN(ICHUNKSZ,IMISSING+5)
  IF(.NOT. YDR%LREADALL) ICHUNKSZ = MIN(ICHUNKSZ,IMISSING)
  IF(ICHUNKSZ > JPMAXCHUNK) CALL ABOR1('IOSTREAM_MIX:SPEC_IN - ICHUNKSZ > JPMAXCHUNK')
  ALLOCATE(ZSPECG(ISPEC2G,ICHUNKSZ/MAX(1,IHELP)+1))
  ALLOCATE(ZSPEC (YDR%YSPF%ISPEC2,ICHUNKSZ))
  ALLOCATE(IMSG(3*ICHUNKSZ))
  ALLOCATE(YDR%IGRBCODES(ICHUNKSZ))
  ALLOCATE(YDR%IHAVEFLD(ICHUNKSZ))
  ALLOCATE(YDR%ILEVS(ICHUNKSZ))
  IFROM(1:ICHUNKSZ) = YD%IOPROCS(1)
  DO 
    IF(YD%LEOF) EXIT
    IF(IMISSING == 0 .AND. .NOT. YDR%LREADALL) EXIT
    ICHUNK = MIN(ICHUNKSZ,IMISSING)
    IF(YDR%LREADALL) ICHUNK=ICHUNKSZ
    IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
      CALL GSTATS(1480,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD)
      DO JFLD=1,ICHUNKSZ/MAX(1,IHELP)+1
        ZSPECG(:,JFLD) = 0.0_JPRB
      ENDDO
!$OMP END PARALLEL DO
      CALL GSTATS(1480,1)
      CALL READ_RECORD(YD,YDR,ICHUNK,PREC=ZSPECG)
      IF(YD%LIOPROC) THEN
        II=0
        DO JFLD=1,MIN(YDR%IFIELDS_IO,ICHUNK)
          IMSG(II+1) = YDR%ILEVS(JFLD)
          IMSG(II+2) = YDR%IGRBCODES(JFLD)
          IMSG(II+3) = YDR%IHAVEFLD(JFLD)
          II=II+3
        ENDDO
        DO JFLD=YDR%IFIELDS_IO+1,ICHUNK
          IMSG(II+1) = -HUGE(IMSG)
          IMSG(II+2) = 0
          IMSG(II+3) = 0
          II=II+3
        ENDDO
      ENDIF
    ENDIF

    CALL GSTATS_BARRIER(726)
    CALL GSTATS(631,0)
    CALL MPL_BROADCAST(IMSG,KTAG=99,KROOT=YD%IOPROCS(1),&
     & CDSTRING='IOSTREAM_MIX:SPEC_IN')
    CALL GSTATS(631,1)
    CALL GSTATS_BARRIER2(726)
    YDR%IFIELDS_IO = ICHUNK
    II=0
    DO JFLD=1,ICHUNK
      IF(IMSG(II+1) == -HUGE(IMSG)) THEN
        YDR%IFIELDS_IO = JFLD-1
        YD%LEOF = .TRUE.
        EXIT
      ELSE
        YDR%ILEVS(JFLD) = IMSG(II+1)
        YDR%IGRBCODES(JFLD) = IMSG(II+2)
        IFROM(JFLD) = IMSG(II+3)
      ENDIF
      II=II+3
    ENDDO
    IF(YDR%LINTERP) THEN
      IFLD=0
!!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD)
      DO JFLD=1,YDR%IFIELDS_IO
        IF(IFROM(JFLD) == YIOS%MYPROC) THEN
          IFLD=IFLD+1
          CALL SPINT(ZSPECG(:,IFLD),ISPEC2G,&
           & YDR%IRESOLI,YDR%YSPF%ISMAX)
        ENDIF
      ENDDO
!!$OMP END PARALLEL DO
    ENDIF

    IFLD=0
    DO JFLD=1,YDR%IFIELDS_IO
      IF(IFROM(JFLD) == YIOS%MYPROC) THEN
        IFLD=IFLD+1
      ENDIF
    ENDDO
    IMYGFLD=IFLD

    IBSET(:)=-1
    IFLD=0
    IFLDG=0
    DO JFLD=1,YDR%IFIELDS_IO
      IF(IMISSINGX == 0 .AND. .NOT. YDR%LREADALL) EXIT
      IFLDG=IFLDG+1
      IF(IFROM(JFLD) == YIOS%MYPROC) THEN
        IFLD=IFLD+1
      ENDIF
      IF(KFLD2 > 0) THEN
        IF(ANY(YDR%YMDL_2D%ILEVS(:) > 0)) THEN
          IFF = IFIND2(YDR%IGRBCODES(JFLD),YDR%ILEVS(JFLD),&
           & YDR%YMDL_2D%IGRIBCODE(:),YDR%YMDL_2D%ILEVS(:))
        ELSE
        IFF = IFIND(YDR%IGRBCODES(JFLD),YDR%YMDL_2D%IGRIBCODE(:))
        ENDIF
        IF(IFF > 0 )THEN
          IF(LLMISSING2DX(IFF) .OR. YDR%LREADALL) THEN
            IBSET(IFLDG) = YDR%YMDL_2D%IBSET(IFF)
            IIFROM(IFLDG)=IFROM(JFLD)
            IMISSINGX = IMISSINGX-1
            LLMISSING2DX(IFF) = .FALSE.
            CYCLE
          ENDIF
        ENDIF
      ENDIF
      IF(YDR%YMDL_3D%NUMFLDS > 0) THEN
        IFF  = IFIND(YDR%IGRBCODES(JFLD),YDR%YMDL_3D%IGRIBCODE(:))
        ILEV = YDR%ILEVS(JFLD)
        IF(IFF > 0 )THEN
          IF( LLMISSING3DX(ILEV,IFF) .OR. YDR%LREADALL )THEN
            LLMISSING3DX(ILEV,IFF) = .FALSE.
            IMISSINGX = IMISSINGX-1
            IBSET(IFLDG) = YDR%YMDL_3D%IBSET(ILEV)
            IIFROM(IFLDG)=IFROM(JFLD)
            CYCLE
          ENDIF
        ENDIF
      ENDIF
! We don't seem to want this field
      WRITE(YIOS%NULOUT,*) 'IOSTREAM : SPEC_IN - SKIPPING FIELD ',YDR%IGRBCODES(JFLD),YDR%ILEVS(JFLD)
      IF(IBSET(IFLDG) == -1) THEN
        IF(IFROM(JFLD) == YIOS%MYPROC) THEN
          DO JJ=IFLD,IMYGFLD-1
            ZSPECG(:,JJ)=ZSPECG(:,JJ+1) 
          ENDDO
          IMYGFLD=IMYGFLD-1
          IFLD=IFLD-1
        ENDIF
        IFLDG=IFLDG-1
      ENDIF
    ENDDO
    
    IF(IFLDG > 0) THEN
      CALL DIST_SPEC(PSPECG=ZSPECG,KFDISTG=IFLDG,KFROM=IIFROM,&
       & KVSET=IBSET,PSPEC=ZSPEC,LDIM1_IS_FLD=.FALSE.,KSMAX=YDR%YSPF%ISMAX)
      ENDIF
    IIFLD=0
    DO JFLD=1,YDR%IFIELDS_IO
      IF(IMISSING == 0 .AND. .NOT. YDR%LREADALL) EXIT
      IF(KFLD2 > 0) THEN
        IF(ANY(YDR%YMDL_2D%ILEVS(:) > 0)) THEN
          IFF = IFIND2(YDR%IGRBCODES(JFLD),YDR%ILEVS(JFLD),&
           & YDR%YMDL_2D%IGRIBCODE(:),YDR%YMDL_2D%ILEVS(:))
        ELSE
        IFF = IFIND(YDR%IGRBCODES(JFLD),YDR%YMDL_2D%IGRIBCODE(:))
        ENDIF
        IF(IFF > 0) THEN
          IF(LLMISSING2D(IFF) .OR. YDR%LREADALL) THEN
            IMISSING = IMISSING-1
            LLMISSING2D(IFF) = .FALSE.
            IF(YDR%YMDL_2D%ILOCFLD(IFF) > 0) THEN
              IIFLD = IIFLD+1
              PSPEC2(:,YDR%YMDL_2D%ILOCFLD(IFF)) = ZSPEC(:,IIFLD)
            ENDIF
            CYCLE
          ENDIF
        ENDIF
      ENDIF
      IF(YDR%YMDL_3D%NUMFLDS > 0) THEN
        IFF  = IFIND(YDR%IGRBCODES(JFLD),YDR%YMDL_3D%IGRIBCODE(:))
        ILEV = YDR%ILEVS(JFLD)
        IF(IFF > 0 )THEN
          IF(LLMISSING3D(ILEV,IFF) .OR. YDR%LREADALL) THEN
            LLMISSING3D(ILEV,IFF) = .FALSE.
            IMISSING = IMISSING-1
            ILOCLV = YDR%YMDL_3D%ILOCLEV(ILEV)
            IF(ILOCLV > 0) THEN
              IIFLD    = IIFLD+1
              PSPEC3(ILOCLV,:,IFF) = ZSPEC(:,IIFLD)
            ENDIF
            CYCLE
          ENDIF
        ENDIF
      ENDIF
    ENDDO
  ENDDO

  LLFAIL = .FALSE.
  IF(KFLD2 > 0)  THEN
    IF(PRESENT(LDMISSING_2D)) THEN
      IF(SIZE(LDMISSING_2D) < KFLD2) &
       & CALL ABOR1('IOSTREAM_MIX:SPEC_IN - LDMISSING_2D TOO SHORT')
      LDMISSING_2D(1:KFLD2) = LLMISSING2D(:)
    ELSE
      DO JFLD=1,KFLD2
        IF(LLMISSING2D(JFLD)) THEN
          WRITE(YIOS%NULOUT,*)'SPECTRAL 2D FIELD MISSING: ',&
           & YDR%YMDL_2D%IGRIBCODE(JFLD)
          LLFAIL = .TRUE.
        ENDIF
      ENDDO
    ENDIF
  ENDIF
  IF(KFLD3 > 0)  THEN
    IF(PRESENT(LDMISSING_3D)) THEN
      IF(SIZE(LDMISSING_3D,1) < KLEV) &
       & CALL ABOR1('IOSTREAM_MIX:SPEC_IN - LDMISSING_3D DIM 1 TOO SMALL')
      IF(SIZE(LDMISSING_3D,2) < KFLD3) &
       & CALL ABOR1('IOSTREAM_MIX:SPEC_IN - LDMISSING_3D DIM 2 TOO SMALL')
      LDMISSING_3D(1:KLEV,1:KFLD3) = LLMISSING3D(1:KLEV,1:KFLD3)
    ELSE
      DO JFLD=1,YDR%YMDL_3D%NUMFLDS
        DO JLEV=1,KLEV
          IF(LLMISSING3D(JLEV,JFLD)) THEN
            WRITE(YIOS%NULOUT,*)'SPECTRAL 3D FIELD MISSING: ',&
             & YDR%YMDL_3D%IGRIBCODE(JFLD),JLEV
            LLFAIL = .TRUE.
          ENDIF
        ENDDO
      ENDDO
    ENDIF
  ENDIF
  IF(LLFAIL) CALL ABOR1('IOSTREAM_MIX:SPEC_IN : MISSING FIELD')
  DEALLOCATE(ZSPECG)
  DEALLOCATE(ZSPEC)
  DEALLOCATE(IMSG)
  DEALLOCATE(YDR%IGRBCODES)
  DEALLOCATE(YDR%IHAVEFLD)
  DEALLOCATE(YDR%ILEVS)
ELSE

  IF(KFLD2 > 0) THEN
    CALL ASSIGN_IOPROC(YD,IFROM2,IMYCOUNT,KFLDPROC2D)
    IBSET2(:) = YDR%YMDL_2D%IBSET(:)
    ALLOCATE(ZSPECG(ISPEC2G,IMYCOUNT))
    ALLOCATE(YDR%IGRBCODES(IMYCOUNT))
    ALLOCATE(YDR%IHAVEFLD(IMYCOUNT))
    ALLOCATE(YDR%ILEVS(IMYCOUNT))
    CALL READ_RECORD(YD,YDR,IMYCOUNT,PREC=ZSPECG)
    IFLD = 0
    DO JFLD=1,KFLD2
      IF(IFROM2(JFLD) == YIOS%MYPROC) THEN
        IFLD = IFLD+1
        IF(YDR%LGRIB) THEN
          IF(YDR%IGRBCODES(IFLD) /= YDR%YMDL_2D%IGRIBCODE(JFLD)) THEN
            WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX:SPEC_IN - EXPECTED CODE ',&
             & YDR%YMDL_2D%IGRIBCODE(JFLD),&
             & ' FOUND CODE ', YDR%IGRBCODES(IFLD)
            CALL ABOR1('IOSTREAM_MIX:SPEC_IN - UNEXPECTED GRIB CODE')
          ENDIF
          IF(ANY(YDR%YMDL_2D%ILEVS(:) > 0)) THEN
            IF(YDR%ILEVS(IFLD) /= YDR%YMDL_2D%ILEVS(JFLD)) THEN
              WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX:SPEC_IN - EXPECTED LEVEL ',&
               & YDR%YMDL_2D%ILEVS(JFLD),&
               & ' FOUND LEVEL ', YDR%ILEVS(IFLD)
              CALL ABOR1('IOSTREAM_MIX:SPEC_IN - UNEXPECTED LEVEL')
            ENDIF
          ENDIF
        ENDIF
      ENDIF
    ENDDO
    CALL DIST_SPEC(PSPECG=ZSPECG,KFDISTG=KFLD2,KFROM=IFROM2,&
     & KVSET=IBSET2,PSPEC=PSPEC2,LDIM1_IS_FLD=.FALSE.,KSMAX=YDR%YSPF%ISMAX)
    DEALLOCATE(ZSPECG)
    DEALLOCATE(YDR%IGRBCODES)
    DEALLOCATE(YDR%IHAVEFLD)
    DEALLOCATE(YDR%ILEVS)
  ENDIF

  IF(YDR%YMDL_3D%NUMFLDS > 0) THEN
    CALL ASSIGN_IOPROC(YD,IFROM3,IMYCOUNT,KLEVPROC3D)
    IBSET3(:) = YDR%YMDL_3D%IBSET(:)
    ALLOCATE(ZSPECGT(IMYCOUNT,ISPEC2G,1))
    ALLOCATE(YDR%IGRBCODES(IMYCOUNT))
    ALLOCATE(YDR%IHAVEFLD(IMYCOUNT))
    ALLOCATE(YDR%ILEVS(IMYCOUNT))
    DO JFLD=1,YDR%YMDL_3D%NUMFLDS
      DO JLEV=1,IMYCOUNT
        CALL READ_RECORD(YD,YDR,1,PREC=ZSPECGT(JLEV,:,:))
      ENDDO
!!$      ILEV = 0
!!$      DO JLEV=1,YDR%YMDL_3D%NLEVS
!!$        IF(IFROM3(JLEV) == YIOS%MYPROC) THEN
!!$          ILEV = ILEV+1
!!$          IF(YDR%LGRIB) THEN
!!$            IF(YDR%IGRBCODES(ILEV) /= YDR%YMDL_3D%IGRIBCODE(JFLD)) THEN
!!$              WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX:SPEC_IN - EXPECTED CODE ',&
!!$               & YDR%YMDL_3D%IGRIBCODE(JFLD),&
!!$               & ' FOUND CODE ', YDR%IGRBCODES(ILEV)
!!$              CALL ABOR1('IOSTREAM_MIX:SPEC_IN - UNEXPECTED GRIB CODE')
!!$            ENDIF
!!$          ENDIF
!!$        ENDIF
!!$      ENDDO
      CALL DIST_SPEC(PSPECG=ZSPECGT(:,:,1),KFDISTG=KLEV,KFROM=IFROM3,&
       & KVSET=IBSET3,PSPEC=PSPEC3(:,:,JFLD),KSMAX=YDR%YSPF%ISMAX)
    ENDDO
    DEALLOCATE(ZSPECGT)
    DEALLOCATE(YDR%IGRBCODES)
    DEALLOCATE(YDR%IHAVEFLD)
    DEALLOCATE(YDR%ILEVS)
  ENDIF
ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:SPEC_IN',1,ZHOOK_HANDLE)
  
END SUBROUTINE SPEC_IN
!=================================================================
SUBROUTINE GRID_IN(YD,YDR,PGRID2,PGRID3,KFLD2,KLEV,KFLD3,&
 &LDMISSING_2D,LDMISSING_3D,KFLDPROC2D)

!**** *GRID_IN*  - Read in grid-point data

! Purpose - Read and distribute grid-point fields

! Explicit arguments :
! --------------------
! YD      - IO stream structure
! YDR     - IO request structure
! PGRID2  - 2-D grid-point fields
! PGRID3  - 3-D grid-point fields
! KFLD2   - number of 2-D grid-point fields
! KLEV    - number of levels in 3-D grid-point fields 
! KFLD3   - number of 3-D grid-point fields
! LDMISSING_2D - missing 2-D fields 
! LDMISSING_2D - missing 3-D fields 
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM) ,INTENT(INOUT) :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PGRID2(:,:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PGRID3(:,:,:,:)
INTEGER(KIND=JPIM),INTENT(IN) :: KFLD2,KLEV,KFLD3
LOGICAL,OPTIONAL,INTENT(OUT)  :: LDMISSING_2D(:)
LOGICAL,OPTIONAL,INTENT(OUT)  :: LDMISSING_3D(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPROC2D(:)

INTEGER(KIND=JPIM) :: IFROM2(KFLD2)
INTEGER(KIND=JPIM) :: IFROM3(KLEV)
INTEGER(KIND=JPIM) :: IGRID2G,JFLD,JLEV,JBLK,IFF,ILEV,IMISSING,ICHUNKSZ,IGPBLKS,II
INTEGER(KIND=JPIM) :: ICHUNK,IHELP
INTEGER(KIND=JPIM),ALLOCATABLE :: IMSG(:)
INTEGER(KIND=JPIM) :: IFROM(JPMAXCHUNK)
INTEGER(KIND=JPIM) :: INOFF2, INOFF3, IFF2(JPMAXCHUNK),IFF3(JPMAXCHUNK),&
 & IFLD2(JPMAXCHUNK),IFLD3(JPMAXCHUNK)
INTEGER(KIND=JPIM) :: ILATS,IGP,IPTS,IBUFLEN,IFLD,IMYCOUNT
INTEGER(KIND=JPIM),ALLOCATABLE  :: ILONS(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZGRIDG(:,:),ZZGRIDG(:),ZGRIDL(:,:,:)
REAL(KIND=JPRB),ALLOCATABLE :: ZLATS(:)
LOGICAL :: LLMISSING2D(KFLD2),LLMISSING3D(KLEV,KFLD3),LLFAIL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRID_IN',0,ZHOOK_HANDLE)

IF(YDR%LRANDOM_ORDER) THEN
  IF(YD%NUMIOPROCS /= 1) &
   & CALL ABOR1('IOSTREAM_MIX:GRID_IN - READING RANDOM FILE WITH > 1 IOPROCS')
  IF(YD%LIONOHELP) THEN
    YD%LIOUSEHELP = .FALSE.
  ELSE
    YD%LIOUSEHELP = YDR%LDISTRIBUTE
  ENDIF
  IF(KFLD2 > 0) LLMISSING2D(:)   = .TRUE.
  IF(KFLD3 > 0) LLMISSING3D(:,:) = .TRUE.
  IMISSING = KLEV*KFLD3+KFLD2
  IF(YDR%LDISTRIBUTE) THEN
    IBUFLEN = YDR%YGPF%IGPTOTG
  ELSE
    IBUFLEN = YIOS%IMAXGRID
  ENDIF
  IF(YD%LIOUSEHELP) THEN
    IHELP=YD%NUMHLP(1)-1
  ELSE
    IHELP=0
  ENDIF
  ICHUNKSZ = YDR%NCHUNKSIZE*MAX(1,IHELP)
  ICHUNKSZ = MIN(ICHUNKSZ,IMISSING+5)
  IF(.NOT. YDR%LREADALL) ICHUNKSZ = MIN(ICHUNKSZ,IMISSING)
  IF(ICHUNKSZ > JPMAXCHUNK) CALL ABOR1('IOSTREAM_MIX:GRID_IN - ICHUNKSZ > JPMAXCHUNK')
  IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
    ALLOCATE(ZGRIDG(IBUFLEN,ICHUNKSZ/MAX(1,IHELP)+1))
  ELSE
    ALLOCATE(ZGRIDG(1,1))
  ENDIF
  IGPBLKS = (YDR%YGPF%IGPTOT-1)/YDR%YGPF%NPROMA+1
  ALLOCATE(ZGRIDL(YDR%YGPF%NPROMA,ICHUNKSZ,IGPBLKS))
  ALLOCATE(IMSG(3*ICHUNKSZ))
  ALLOCATE(YDR%IGRBCODES(ICHUNKSZ))
  ALLOCATE(YDR%ILEVS(ICHUNKSZ))
  ALLOCATE(YDR%IHAVEFLD(ICHUNKSZ))
  IFROM(1:ICHUNKSZ) = YD%IOPROCS(1)
  DO 
    IF(YD%LEOF) EXIT
    IF(IMISSING == 0 .AND. .NOT. YDR%LREADALL) EXIT
    ICHUNK = MIN(ICHUNKSZ,IMISSING)
    IF(YDR%LREADALL) ICHUNK=ICHUNKSZ
    IF(ANY(YD%IOPROCSHLP(1,:) == YIOS%MYPROC)) THEN
      CALL READ_RECORD(YD,YDR,ICHUNK,PREC=ZGRIDG)
      IF(YD%LIOPROC) THEN
        II=0
        DO JFLD=1,YDR%IFIELDS_IO
          IMSG(II+1) = YDR%ILEVS(JFLD)
          IMSG(II+2) = YDR%IGRBCODES(JFLD)
          IMSG(II+3) = YDR%IHAVEFLD(JFLD)
          II=II+3
        ENDDO
        DO JFLD=YDR%IFIELDS_IO+1,ICHUNK
          IMSG(II+1) = -HUGE(IMSG)
          IMSG(II+2) = 0
          IMSG(II+3) = 0
          II=II+3
        ENDDO
      ENDIF
    ENDIF
    CALL GSTATS_BARRIER(727)
    CALL GSTATS(632,0)
    CALL MPL_BROADCAST(IMSG,KTAG=99,KROOT=YD%IOPROCS(1),&
     & CDSTRING='IOSTREAM_MIX:GRID_IN')
    CALL GSTATS(632,1)
    CALL GSTATS_BARRIER2(727)
    YDR%IFIELDS_IO = ICHUNK
    II=0
    DO JFLD=1,ICHUNK
      IF(IMSG(II+1) == -HUGE(IMSG)) THEN
        YDR%IFIELDS_IO = JFLD-1
        YD%LEOF = .TRUE.
        EXIT
      ELSE
        YDR%ILEVS(JFLD) = IMSG(II+1)
        YDR%IGRBCODES(JFLD) = IMSG(II+2)
        IFROM(JFLD) = IMSG(II+3)
      ENDIF
      II=II+3
    ENDDO
    IF(YDR%IFIELDS_IO == 0) EXIT
    IF(YDR%LINTERP) THEN
      IF(YIOS%NDGLG == YIOS%NUNDEF) CALL ABOR1('IOSTREAM_MIX:GRID_IN YIOS%NDGLG NOT DEFINED')
      IF(.NOT.ASSOCIATED(YIOS%NLOENG))  CALL ABOR1('IOSTREAM_MIX:GRID_IN YIOS%NLOENG NOT DEFINED')
      IF(.NOT.ASSOCIATED(YIOS%RLATIG))  CALL ABOR1('IOSTREAM_MIX:GRID_IN YIOS%RLATIG NOT DEFINED')
      IF(ANY(IFROM(1:YDR%IFIELDS_IO) == YIOS%MYPROC)) THEN
        ALLOCATE(ILONS(YIOS%NDGLG))
        ALLOCATE(ZLATS(YIOS%NDGLG))
        CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KLATS=ILATS,KLONS=ILONS,&
         & PLATS=ZLATS,KPTS=IGP)
        ALLOCATE(ZZGRIDG(IGP))
        IFLD=0
        DO JFLD=1,YDR%IFIELDS_IO
          IF(IFROM(JFLD) == YIOS%MYPROC) THEN
            IFLD=IFLD+1
            ZZGRIDG(1:IGP) = ZGRIDG(1:IGP,IFLD)
            CALL INTERP_GP(YDR%NTYPE_INTERP,YDR%IGRBCODES(JFLD),YDR%ILEVS(JFLD),&
             & ILATS,ILONS,ZLATS,YIOS%NDGLG,YIOS%NLOENG(1:YIOS%NDGLG),YIOS%RLATIG(1:YIOS%NDGLG),&
             & ZZGRIDG,ZGRIDG(1:YDR%YGPF%IGPTOTG,IFLD))
          ENDIF
        ENDDO
        DEALLOCATE(ZZGRIDG)
        DEALLOCATE(ILONS)
        DEALLOCATE(ZLATS)
      ENDIF
    ENDIF

    IF(YDR%LDISTRIBUTE) THEN
      CALL DIST_GRID(PGPG=ZGRIDG,KFDISTG=YDR%IFIELDS_IO,KFROM=IFROM(1:YDR%IFIELDS_IO),&
       & PGP=ZGRIDL,KPROMA=YDR%YGPF%NPROMA)
    ENDIF

    INOFF2 = 0
    INOFF3 = 0
    DO JFLD=1,YDR%IFIELDS_IO
      IF(IMISSING == 0 .AND. .NOT. YDR%LREADALL) EXIT
      IF(KFLD2 > 0) THEN
        IF(ANY(YDR%YMDL_2D%ILEVS(:) > 0)) THEN
          IFF = IFIND2(YDR%IGRBCODES(JFLD),YDR%ILEVS(JFLD),&
           & YDR%YMDL_2D%IGRIBCODE(:),YDR%YMDL_2D%ILEVS(:))
        ELSE
          IFF = IFIND(YDR%IGRBCODES(JFLD),YDR%YMDL_2D%IGRIBCODE(:))
        ENDIF
        IF( IFF > 0 )THEN
          IF( LLMISSING2D(IFF) .OR. YDR%LREADALL ) THEN
            IMISSING = IMISSING-1
            LLMISSING2D(IFF) = .FALSE.
            INOFF2 = INOFF2+1
            IFF2(INOFF2) = IFF
            IFLD2(INOFF2) = JFLD
            CYCLE
          ENDIF
        ENDIF
      ENDIF

      IF(YDR%YMDL_3D%NUMFLDS > 0) THEN
        IFF  = IFIND(YDR%IGRBCODES(JFLD),YDR%YMDL_3D%IGRIBCODE(:))
        ILEV = YDR%ILEVS(JFLD)
        IF( IFF > 0)THEN
          IF( LLMISSING3D(ILEV,IFF) .OR. YDR%LREADALL )THEN
            LLMISSING3D(ILEV,IFF) = .FALSE.
            IMISSING = IMISSING-1
            INOFF3 = INOFF3+1
            IFF3(INOFF3) = IFF
            IFLD3(INOFF3) = JFLD
            CYCLE
          ENDIF
        ENDIF
      ENDIF
    ENDDO

    IF(YDR%LDISTRIBUTE) THEN
      CALL GSTATS(1481,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,IFF,IFLD,JBLK)
      DO JFLD=1,INOFF2
        IFF  = IFF2(JFLD)
        IFLD = IFLD2(JFLD)
        DO JBLK=1,IGPBLKS
          PGRID2(:,IFF,JBLK) = ZGRIDL(:,IFLD,JBLK)
        ENDDO
      ENDDO
!$OMP END PARALLEL DO
      CALL GSTATS(1481,1)
    ELSEIF(YD%IOPROCS(1) == YIOS%MYPROC) THEN
      DO JFLD=1,INOFF2
        IFF  = IFF2(JFLD)
        IFLD = IFLD2(JFLD)
        CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KPTS=IPTS)
        IF(SIZE(PGRID2,1) < IPTS) THEN
          WRITE(YIOS%NULERR,*) ' SIZE(PGRID2,1),IPTS ',SIZE(PGRID2,1),IPTS,JFLD
          CALL ABOR1('IOSTREAM_MIX:GRID_IN - DIM 1 OF PGRID2 TOO SMALL')
        ENDIF
        CALL COPYGP_GLOB2LOC(ZGRIDG(:,IFLD:IFLD),PGRID2(:,IFF:IFF,:),&
         & YDR%YGPF%NPROMA,IPTS)
      ENDDO
    ENDIF

    IF(YDR%LDISTRIBUTE) THEN
      CALL GSTATS(1481,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,IFF,IFLD,ILEV,JBLK)
      DO JFLD=1,INOFF3
        IFF  = IFF3(JFLD)
        IFLD = IFLD3(JFLD)
        ILEV = YDR%ILEVS(IFLD)
        DO JBLK=1,IGPBLKS
          PGRID3(:,ILEV,IFF,JBLK) = ZGRIDL(:,IFLD,JBLK)
        ENDDO
      ENDDO
!$OMP END PARALLEL DO
      CALL GSTATS(1481,1)
    ELSEIF(YD%IOPROCS(1) == YIOS%MYPROC) THEN
      DO JFLD=1,INOFF3
        IFF  = IFF3(JFLD)
        IFLD = IFLD3(JFLD)
        ILEV = YDR%ILEVS(IFLD)
        CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KPTS=IPTS)
        IF(SIZE(PGRID3,1) < IPTS) &
         & CALL ABOR1('IOSTREAM_MIX:GRID_IN - DIM 1 OF PGRID3 TOO SMALL')
        CALL COPYGP_GLOB2LOC(ZGRIDG(:,IFLD:IFLD),PGRID3(:,ILEV:ILEV,IFF,:),&
         & YDR%YGPF%NPROMA,IPTS)
      ENDDO
    ENDIF

  ENDDO

  LLFAIL = .FALSE.
  IF(KFLD2 > 0)  THEN
    IF(PRESENT(LDMISSING_2D)) THEN
      IF(SIZE(LDMISSING_2D) < KFLD2) &
       & CALL ABOR1('IOSTREAM_MIX:GRID_IN - LDMISSING_2D TOO SHORT')
      LDMISSING_2D(1:KFLD2) = LLMISSING2D(:)
    ELSE
      DO JFLD=1,KFLD2
        IF(LLMISSING2D(JFLD)) THEN
          WRITE(YIOS%NULOUT,*)'GRIDPOINT 2D FIELD MISSING: ',&
           & YDR%YMDL_2D%IGRIBCODE(JFLD)
          LLFAIL = .TRUE.
        ENDIF
      ENDDO
    ENDIF
  ENDIF
  IF(KFLD3 > 0)  THEN
    IF(PRESENT(LDMISSING_3D)) THEN
      IF(SIZE(LDMISSING_3D,1) < KLEV) &
       & CALL ABOR1('IOSTREAM_MIX:GRID_IN - LDMISSING_3D DIM 1 TOO SMALL')
      IF(SIZE(LDMISSING_3D,2) < KFLD3) &
       & CALL ABOR1('IOSTREAM_MIX:GRID_IN - LDMISSING_3D DIM 2 TOO SMALL')
      LDMISSING_3D(1:KLEV,1:KFLD3) = LLMISSING3D(:,:)
    ELSE
      DO JFLD=1,YDR%YMDL_3D%NUMFLDS
        DO JLEV=1,KLEV
          IF(LLMISSING3D(JLEV,JFLD)) THEN
            WRITE(YIOS%NULOUT,*)'GRIDPOINT 3D FIELD MISSING: ',&
             & YDR%YMDL_3D%IGRIBCODE(JFLD),JLEV
            LLFAIL = .TRUE.
          ENDIF
        ENDDO
      ENDDO
    ENDIF
  ENDIF
  IF(LLFAIL) CALL ABOR1('IOSTREAM_MIX:GRID_IN : MISSING FIELD')
  IF(ALLOCATED(ZGRIDG)) DEALLOCATE(ZGRIDG)
  DEALLOCATE(ZGRIDL)
  DEALLOCATE(IMSG)
  DEALLOCATE(YDR%IGRBCODES)
  DEALLOCATE(YDR%IHAVEFLD)
  DEALLOCATE(YDR%ILEVS)
ELSE

  IF(KFLD2 > 0) THEN
    CALL ASSIGN_IOPROC(YD,IFROM2,IMYCOUNT,KFLDPROC2D)
    IGRID2G = YDR%YGPF%IGPTOTG
    ALLOCATE(ZGRIDG(IGRID2G,IMYCOUNT))
    ALLOCATE(YDR%IGRBCODES(IMYCOUNT))
    ALLOCATE(YDR%IHAVEFLD(IMYCOUNT))
    ALLOCATE(YDR%ILEVS(IMYCOUNT))
    IF(YD%LIOPROC) THEN
      CALL READ_RECORD(YD,YDR,IMYCOUNT,PREC=ZGRIDG)
      IFLD = 0
      DO JFLD=1,KFLD2
        IF(IFROM2(JFLD) == YIOS%MYPROC) THEN
          IFLD = IFLD+1
          IF(YDR%LGRIB) THEN
            IF(YDR%IGRBCODES(IFLD) /= YDR%YMDL_2D%IGRIBCODE(JFLD)) THEN
              WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX:GRID_IN - EXPECTED CODE ',&
               & YDR%YMDL_2D%IGRIBCODE(JFLD),&
               & ' FOUND CODE ', YDR%IGRBCODES(IFLD)
              CALL ABOR1('IOSTREAM_MIX:GRID_IN - UNEXPECTED GRIB CODE')
            ENDIF
            IF(ANY(YDR%YMDL_2D%ILEVS(:) > 0)) THEN
              IF(YDR%ILEVS(IFLD) /= YDR%YMDL_2D%ILEVS(JFLD)) THEN
                WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX:GRID_IN - EXPECTED LEVEL ',&
                 & YDR%YMDL_2D%ILEVS(JFLD),&
                 & ' FOUND LEVEL ', YDR%ILEVS(IFLD)
                CALL ABOR1('IOSTREAM_MIX:GRID_IN - UNEXPECTED LEVEL')
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDDO
    ENDIF
    CALL DIST_GRID(PGPG=ZGRIDG,KFDISTG=KFLD2,KFROM=IFROM2,&
     & PGP=PGRID2,KPROMA=YDR%YGPF%NPROMA)
    DEALLOCATE(ZGRIDG)
    DEALLOCATE(YDR%IGRBCODES)
    DEALLOCATE(YDR%IHAVEFLD)
    DEALLOCATE(YDR%ILEVS)
  ENDIF

  IF(YDR%YMDL_3D%NUMFLDS > 0) THEN
    CALL ASSIGN_IOPROC(YD,IFROM3,IMYCOUNT)
    IGRID2G = YDR%YGPF%IGPTOTG
    ALLOCATE(ZGRIDG(IGRID2G,IMYCOUNT))
    ALLOCATE(YDR%IGRBCODES(IMYCOUNT))
    ALLOCATE(YDR%IHAVEFLD(IMYCOUNT))
    ALLOCATE(YDR%ILEVS(IMYCOUNT))
    DO JFLD=1,YDR%YMDL_3D%NUMFLDS
      CALL READ_RECORD(YD,YDR,IMYCOUNT,PREC=ZGRIDG)
      CALL DIST_GRID(PGPG=ZGRIDG,KFDISTG=KLEV,KFROM=IFROM3,&
       & PGP=PGRID3(:,:,JFLD,:),KPROMA=YDR%YGPF%NPROMA)
    ENDDO
    DEALLOCATE(ZGRIDG)
    DEALLOCATE(YDR%IGRBCODES)
    DEALLOCATE(YDR%IHAVEFLD)
    DEALLOCATE(YDR%ILEVS)
  ENDIF

ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRID_IN',1,ZHOOK_HANDLE)
END SUBROUTINE GRID_IN
!=============================================================
SUBROUTINE WRITE_RECORD(YD,YDR,KFIELDS,PREC,KREC,PREC1,KREC1,CDREC,&
 & KALLFLDS,KIOFLDS,KHAVEFLDS)

!**** *WRITE_RECORD*  - Write out record

! Purpose - To write a record to device .

! Explicit arguments :
! --------------------
! YD   - IO stream structure
! YDR  - IO request structure
! KFIELDS - number of records
! PREC - real data
! KREC = integer data
! CDREC = character string data
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT) :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS
REAL(KIND=JPRB),OPTIONAL,INTENT(IN)    :: PREC(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KREC(:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(IN)    :: PREC1(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KREC1(:)
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(IN) :: CDREC
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KALLFLDS
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KIOFLDS(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KHAVEFLDS(:)


INTEGER(KIND=JPIM) :: IBYTES(KFIELDS),IRET,ISIZE,JFLD,ILENINT,I,J,IHELP
REAL(KIND=JPRB) :: ZTIME0,ZTIME1
REAL(KIND=JPRB) :: ZHOOK_HANDLE
CHARACTER :: CLPAR*6,CLEVEL*4,CLCHANNEL*4
REAL(KIND=JPRB),ALLOCATABLE :: ZREC(:,:)
CHARACTER(LEN=YIOS%NINTLEN) :: CLREC
INTEGER(KIND=JPIM), ALLOCATABLE :: IREC(:)
INTEGER(KIND=JPIM) :: IFIELDS_CODE,ICHUNKSZ,JJFLD,IFI,ILA,IFLDS,IFLD
INTEGER(KIND=JPIM) :: ITAG,IPROCHLP,ILRECV,INUM,ISENDREQ
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:WRITE_RECORD',0,ZHOOK_HANDLE)

YDR%IFIELDS_IO = KFIELDS
IBYTES(:) = 0
IF(YD%LIOUSEHELP) THEN
  IFIELDS_CODE = COUNT(YDR%IHAVEFLD(1:KFIELDS) == YIOS%MYPROC)
  ICHUNKSZ = YDR%NCHUNKSIZE
ELSE
  IFIELDS_CODE=KFIELDS
  ICHUNKSZ = KFIELDS
ENDIF

IF(YDR%LGRIB) THEN
  IF(.NOT.PRESENT(PREC)) CALL ABOR1('IOSTREAM_MIX:WRITE_RECORD - PREC MISSING')
  IF(YD%LIOPROC.OR.(YD%LIOPROCHLP.AND.YD%LIOUSEHELP)) THEN
    CALL GRIB_ENCODE(YDR,PREC,IFIELDS_CODE)
  ENDIF
ENDIF

IFLD=0
IF(YD%LIOPROC) THEN
  INUM=IFIND(YIOS%MYPROC,YD%IOPROCS)
  IHELP=YD%NUMHLP(INUM)
ELSE
  IHELP=-97
ENDIF
DO JJFLD=1,KFIELDS,MAX(1,ICHUNKSZ)
  IFI = JJFLD
  ILA = MIN(JJFLD+ICHUNKSZ-1,KFIELDS)
  IFLDS = ILA-IFI+1
  IF(YD%LIOUSEHELP) THEN
    CALL GSTATS_BARRIER(738)
    IF((YD%LIOPROC .AND. IHELP > 1) .OR. (YD%LIOPROCHLP .AND. IFIELDS_CODE>0)) THEN
      CALL GSTATS(649,0)
      IF(YD%LIOPROC) CALL ALLO_IGRIB(YDR,IFLDS)
      DO JFLD=IFI,ILA
        ITAG=16000+JFLD
        IF(YDR%IHAVEFLD(JFLD) == YIOS%MYPROC) THEN
          IFLD=IFLD+1
          CALL MPL_SEND(NGRIBD(NGSTA(IFLD):NGSTA(IFLD+1)-1),&
           & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ, &
           & KDEST=YD%MIOPROCHLP,KTAG=ITAG,&
           & CDSTRING='IOSTREAM_MIX:WRITE_RECORD')
          CALL MPL_WAIT(NGRIBD,KREQUEST=ISENDREQ, &
           & CDSTRING='IOSTREAM_MIX:WRITE_RECORD')
        ELSEIF(YD%LIOPROC) THEN
          IFLD=JFLD-IFI+1
          IPROCHLP=IGETPROCHLP(YD,JFLD)
          CALL MPL_RECV(NGRIBD(NGSTA(IFLD):),KSOURCE=IPROCHLP,KTAG=ITAG,&
           & KOUNT=ILRECV,KMP_TYPE=JP_BLOCKING_STANDARD,CDSTRING='IOSTREAM_MIX:WRITE_RECORD')
          NGSTA(IFLD+1) = NGSTA(IFLD)+ILRECV
        ENDIF
      ENDDO
      CALL GSTATS(649,1)
    ENDIF
    CALL GSTATS_BARRIER2(738)
  ENDIF
  IF(YD%LIOPROC) THEN
    CALL GSTATS(1764,0)
    CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)
    SELECT CASE(YD%IOTYPE)
    CASE(JPCIO)
      IF(YDR%LGRIB) THEN
        IBYTES(1) = (NGSTA(IFLDS+1)-1)*YIOS%NINTLEN
        CALL IGRIB_WRITE_BYTES(YD%IFILE_HANDLE,NGRIBD,IBYTES(1))
      ELSE
        IF(PRESENT(PREC)) THEN
          ISIZE = SIZE(PREC,1)
          IFLDS = SIZE(PREC,2)
          IBYTES(1) = ISIZE*YIOS%NREALEN
          DO J=1,IFLDS
            CALL IGRIB_WRITE_BYTES(YD%IFILE_HANDLE,PREC(:,J),IBYTES(1))
          ENDDO
          IBYTES(1)=IBYTES(1)*IFLDS
        ELSEIF(PRESENT(PREC1)) THEN
          ISIZE = SIZE(PREC1)
          IBYTES(1) = ISIZE*YIOS%NREALEN
          CALL IGRIB_WRITE_BYTES(YD%IFILE_HANDLE,PREC1,IBYTES(1))
        ELSEIF(PRESENT(KREC)) THEN
          ISIZE = SIZE(KREC,1)
          IFLDS = SIZE(KREC,2)
          IBYTES(1) = ISIZE*YIOS%NINTLEN
          DO J=1,IFLDS
            CALL IGRIB_WRITE_BYTES(YD%IFILE_HANDLE,KREC(:,J),IBYTES(1))
          ENDDO
          IBYTES(1)=IBYTES(1)*IFLDS
        ELSEIF(PRESENT(KREC1)) THEN
          ISIZE = SIZE(KREC1)
          IBYTES(1) = ISIZE*YIOS%NINTLEN
          CALL IGRIB_WRITE_BYTES(YD%IFILE_HANDLE,KREC1,IBYTES(1))
        ELSEIF(PRESENT(CDREC)) THEN
          IBYTES(1) = LEN(CDREC) !! NB: One-byte characters are assumed!
          ALLOCATE(IREC( (LEN(CDREC)+YIOS%NINTLEN-1)/YIOS%NINTLEN ))
          I=1
          DO J=1,SIZE(IREC)
            CLREC=CDREC(I:MIN(LEN(CDREC),I+YIOS%NINTLEN-1))
            READ(CLREC,'(A)') IREC(J)
            I=I+YIOS%NINTLEN
          ENDDO
          CALL IGRIB_WRITE_BYTES(YD%IFILE_HANDLE,IREC,IBYTES(1))
          DEALLOCATE(IREC)
        ENDIF
      ENDIF
    CASE(JPFDB)
      DO JFLD=1,KFIELDS
        IFLD = JFLD+IFI-1
!HH   Unfortunately there is NO handle to specify a GRIB table number in FDB
!HH   Therefore, the following dirty, clumsy trick is required
        IF(YDR%IGRBCODES(IFLD)/1000 == 151) THEN
          WRITE(CLPAR,'(I6.6)') MOD(YDR%IGRBCODES(IFLD),1000)
        ELSE
          WRITE(CLPAR,'(I6.6)') YDR%IGRBCODES(IFLD)
        ENDIF
        IRET = ISETVALFDBSUBS(YD%IFILE_HANDLE,'PARAMETER',CLPAR)
        IF(YDR%CLEVTYPE == 'SFC') THEN
          WRITE(CLEVEL,'(I4.4)') 0
        ELSEIF(YDR%CLEVTYPE == 'PL') THEN
          IF( YDR%ILEVS(IFLD) < 100 ) THEN
            WRITE(CLEVEL,'(F4.2)') REAL(YDR%ILEVS(IFLD),JPRB)/100._JPRB ! HPa
          ELSE
            WRITE(CLEVEL,'(I4.4)') YDR%ILEVS(IFLD)/100 ! To HPa
          ENDIF
        ELSE
          WRITE(CLEVEL,'(I4.4)') YDR%ILEVS(IFLD)
        ENDIF
        IRET = ISETVALFDBSUBS(YD%IFILE_HANDLE,'LEVEL',CLEVEL)
        IF(YDR%IGRBCODES(JFLD) == NGRBBTMP) THEN
          WRITE(CLCHANNEL,'(I4.4)') YDR%ILEVS(JFLD)
          IRET = ISETVALFDBSUBS(YD%IFILE_HANDLE,'CHANNEL',CLCHANNEL)
        ELSE
          IRET = ISETVALFDBSUBS(YD%IFILE_HANDLE,'CHANNEL','off')
        ENDIF
        ILENINT = NGSTA(JFLD+1)-NGSTA(JFLD)
        IBYTES(JFLD) = ILENINT*YIOS%NINTLEN
        IRET = IWRITEFDBSUBS(YD%IFILE_HANDLE,NGRIBD(NGSTA(JFLD):NGSTA(JFLD+1)-1),ILENINT)
        IF( IRET < 0 )THEN
          CALL ABOR1('IOSTREAM_MIX:WRITE_RECORD - FAIL')
        ENDIF
      ENDDO
    END SELECT
    CALL GSTATS(1764,1)
    CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
    YD%WALLCLOCK = YD%WALLCLOCK+(ZTIME1-ZTIME0)
    TOTAL_WALLCLOCK = TOTAL_WALLCLOCK+(ZTIME1-ZTIME0)
  ENDIF
  YD%NBYTES = YD%NBYTES+SUM(IBYTES(1:YDR%IFIELDS_IO))
ENDDO

YD%NRECS = YD%NRECS+YDR%IFIELDS_IO


IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:WRITE_RECORD',1,ZHOOK_HANDLE)

END SUBROUTINE WRITE_RECORD
!=============================================================
SUBROUTINE READ_RECORD(YD,YDR,KFIELDS,PREC,KREC,PREC1,KREC1,CDREC)

!**** *READ_RECORD*  - Read in record

! Purpose - To read a record from device .

! Explicit arguments :
! --------------------
! YD   - IO stream structure
! YDR  - IO request structure
! KFIELDS - number of records
! PREC - real data
! KREC = integer data
! CDREC = character string data
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(INOUT) :: YD
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT)    :: PREC(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KREC(:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT)    :: PREC1(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KREC1(:)
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(OUT) :: CDREC

INTEGER(KIND=JPIM) :: ILEN_BYTES,IRET,IBYTES(KFIELDS),ISIZE,JFLD,I,J,JJFLD,ILENGRB
INTEGER(KIND=JPIM) :: IMSG(2),ITAG,IFLD,IPROCHLP,ILRECV,INUM,ISEND,IOFF,IRBUF,ISIZEBUF
INTEGER(KIND=JPIM) :: IMINBUF
REAL(KIND=JPRB) :: ZTIME0,ZTIME1
CHARACTER(LEN=YIOS%NINTLEN) :: CLREC
INTEGER(KIND=JPIM), ALLOCATABLE :: IREC(:),IGRIBMSG(:)
INTEGER(KIND=JPIM) :: ISENDREQ(KFIELDS),ILENSEND(KFIELDS),ITAGSEND(KFIELDS),IPROCSEND(KFIELDS)
INTEGER(KIND=JPIM) :: IOFFSEND(KFIELDS+1)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:READ_RECORD',0,ZHOOK_HANDLE)

YD%LEOF = .FALSE.
IF(YDR%LGRIB) THEN
  IF(.NOT.PRESENT(PREC)) CALL ABOR1('IOSTREAM_MIX:READ_RECORD - PREC MISSING')
  ILENGRB = SIZE(PREC(:,1))+8000
  IF(YD%LIOPROC) THEN
    INUM=IFIND(YIOS%MYPROC,YD%IOPROCS)
    IF(YD%NUMHLP(INUM) > 1 .AND. YD%LIOUSEHELP) THEN
      IMINBUF=(1024*1024*10)/YIOS%NINTLEN ! 10 Mbytes
      ALLOCATE(IGRIBMSG(MAX(ILENGRB*YDR%NCHUNKSIZE,IMINBUF)))
      ISIZEBUF=SIZE(IGRIBMSG)
      IOFFSEND(1)=0
    ELSE
      CALL ALLO_IGRIB(YDR,KFIELDS,ILENGRB)
    ENDIF
  ENDIF
  IF(YD%LIOPROCHLP) THEN
    CALL ALLO_IGRIB(YDR,YDR%NCHUNKSIZE+1)
  ENDIF
ENDIF
IF(YD%LIOPROC) THEN
  YDR%IFIELDS_IO = KFIELDS
ELSE
  YDR%IFIELDS_IO = 0
ENDIF
YDR%IFIELDS_HAVE=0
INUM=IFIND(YIOS%MYPROC,YD%IOPROCS)
ISEND=0
CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)
IF(YD%LIOUSEHELP) CALL GSTATS_BARRIER(739)
CALL GSTATS(650,0)
CALL GSTATS(650,2)
CALL GSTATS(1765,0)
DO JFLD=1,YDR%IFIELDS_IO
  SELECT CASE(YD%IOTYPE)
  CASE(JPCIO)
    IF(YDR%LGRIB) THEN
      IF(YD%NUMHLP(INUM) == 1 .OR. .NOT. YD%LIOUSEHELP) THEN
        ILEN_BYTES = SIZE(NGRIBD(NGSTA(JFLD):))*YIOS%NINTLEN
        CALL IGRIB_READ_FROM_FILE(YD%IFILE_HANDLE,NGRIBD(NGSTA(JFLD):),ILEN_BYTES,IRET)
        IBYTES(JFLD)=ILEN_BYTES
        IF(IRET >= 0) THEN
          NGSTA(JFLD+1) = NGSTA(JFLD)+(IBYTES(JFLD)+YIOS%NINTLEN-1)/YIOS%NINTLEN
          YDR%IFIELDS_HAVE=YDR%IFIELDS_HAVE+1
          YDR%IHAVEFLD(JFLD)=YIOS%MYPROC
        ENDIF
      ELSE
        ISEND=ISEND+1
        ILEN_BYTES = (ISIZEBUF-IOFFSEND(ISEND))*YIOS%NINTLEN
        CALL IGRIB_READ_FROM_FILE(YD%IFILE_HANDLE,IGRIBMSG(IOFFSEND(ISEND)+1:),ILEN_BYTES,IRET)
        IBYTES(JFLD)=ILEN_BYTES
        IF(IRET == -1 .AND. YDR%LRANDOM_ORDER) THEN
          ILENSEND(ISEND)=1
        ELSE
          ILENSEND(ISEND)=(IBYTES(JFLD)+YIOS%NINTLEN-1)/YIOS%NINTLEN
        ENDIF
        IOFFSEND(ISEND+1)=IOFFSEND(ISEND)+ILENSEND(ISEND)
        IRBUF=ISIZEBUF-IOFFSEND(ISEND+1)
        ITAG=15000+JFLD
        ITAGSEND(ISEND)=ITAG
        IPROCSEND(ISEND)=IGETPROCHLP(YD,JFLD)
        CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
        YD%WALLCLOCK = YD%WALLCLOCK+(ZTIME1-ZTIME0)
        CALL GSTATS(1765,2)
        CALL GSTATS(650,3)
        IOFF=IOFFSEND(ISEND)
        CALL MPL_SEND(IGRIBMSG(IOFF+1:IOFF+ILENSEND(ISEND)),KDEST=IPROCSEND(ISEND),KTAG=ITAGSEND(ISEND),&
         & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(ISEND), &
         & CDSTRING='IOSTREAM_MIX:READ_RECORD')
        CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)
        IF(JFLD == YDR%IFIELDS_IO .OR. IRBUF < ILENGRB .OR. ILENSEND(ISEND) == 1) THEN
          CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
          YD%WALLCLOCK = YD%WALLCLOCK+(ZTIME1-ZTIME0)
          CALL MPL_WAIT(IGRIBMSG(:),KREQUEST=ISENDREQ(1:ISEND),CDSTRING='IOSTREAM_MIX:READ_RECORD')
! Sign off helpers
          IF(ILENSEND(ISEND) == 1) THEN
            ISEND=0
            DO JJFLD=JFLD+1,YDR%IFIELDS_IO
              IF(IGETHLP(YD,JFLD) == IGETHLP(YD,JJFLD) ) EXIT
              ISEND=ISEND+1
              ITAG=15000+JJFLD
              IPROCHLP=IGETPROCHLP(YD,JJFLD)
              CALL MPL_SEND(IGRIBMSG(IOFF+1:IOFF+1),KDEST=IPROCHLP,KTAG=ITAG,&
               & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(ISEND), &
               & CDSTRING='IOSTREAM_MIX:READ_RECORD')
            ENDDO
            CALL MPL_WAIT(IGRIBMSG(:),KREQUEST=ISENDREQ(1:ISEND),CDSTRING='IOSTREAM_MIX:READ_RECORD')
          ENDIF
          ISEND=0
          CALL USER_CLOCK(PELAPSED_TIME=ZTIME0)
        ENDIF
        CALL GSTATS(650,2)
        CALL GSTATS(1765,3)
      ENDIF
    ELSE
      IF(PRESENT(PREC)) THEN
        ISIZE = SIZE(PREC,1)
        IBYTES(JFLD) = ISIZE*YIOS%NREALEN
        CALL IGRIB_READ_BYTES(YD%IFILE_HANDLE,PREC(:,JFLD),IBYTES(JFLD),IRET)
      ELSEIF(PRESENT(PREC1)) THEN
        ISIZE = SIZE(PREC1)
        IBYTES(JFLD) = ISIZE*YIOS%NREALEN
        CALL IGRIB_READ_BYTES(YD%IFILE_HANDLE,PREC1,IBYTES(JFLD),IRET)
      ELSEIF(PRESENT(KREC)) THEN
        ISIZE = SIZE(KREC,1)
        IBYTES(JFLD) = ISIZE*YIOS%NINTLEN
        CALL IGRIB_READ_BYTES(YD%IFILE_HANDLE,KREC(:,JFLD),IBYTES(JFLD),IRET)
      ELSEIF(PRESENT(KREC1)) THEN
        ISIZE = SIZE(KREC1)
        IBYTES(JFLD) = ISIZE*YIOS%NINTLEN
        CALL IGRIB_READ_BYTES(YD%IFILE_HANDLE,KREC1,IBYTES(JFLD),IRET)
      ELSEIF(PRESENT(CDREC)) THEN
        IBYTES(JFLD) = LEN(CDREC) !! NB: One-byte characters are assumed!
        ALLOCATE(IREC( (LEN(CDREC)+YIOS%NINTLEN-1)/YIOS%NINTLEN ))
        CALL IGRIB_READ_BYTES(YD%IFILE_HANDLE,IREC,IBYTES(JFLD),IRET)
        I=1
        DO J=1,SIZE(IREC)
          WRITE(CLREC,'(A)') IREC(J)
          CDREC(I:MIN(LEN(CDREC),I+YIOS%NINTLEN-1))=CLREC
          I=I+YIOS%NINTLEN
        ENDDO
        DEALLOCATE(IREC)
      ENDIF
    ENDIF
  END SELECT
  IF( IRET < 0 )THEN
    IF(IRET == -1 .AND. YDR%LRANDOM_ORDER) THEN
      YD%LEOF = .TRUE.
      YDR%IFIELDS_IO = JFLD-1
      EXIT
    ELSE
      WRITE(YIOS%NULERR,*) 'IOSTREAM_MIX:READ_RECORD ',IRET,KFIELDS,JFLD,SIZE(PREC,1)
      CALL ABOR1('IOSTREAM_MIX:READ_RECORD - FAIL')
    ENDIF
  ENDIF
ENDDO
CALL GSTATS(1765,1) 
CALL GSTATS(650,3)
CALL GSTATS(650,1)
CALL USER_CLOCK(PELAPSED_TIME=ZTIME1)
YD%WALLCLOCK = YD%WALLCLOCK+(ZTIME1-ZTIME0)
TOTAL_WALLCLOCK = TOTAL_WALLCLOCK+(ZTIME1-ZTIME0)
YD%NRECS = YD%NRECS+YDR%IFIELDS_IO
YD%NBYTES = YD%NBYTES+SUM(IBYTES(1:YDR%IFIELDS_IO))

IF(YDR%LGRIB .AND. KFIELDS >0) THEN
  IF( YD%LIOUSEHELP ) THEN
    IF( YD%LIOPROCHLP) THEN
      CALL GSTATS(650,0)
      YDR%IFIELDS_HAVE=0
      IFLD=0
      RLOOP:DO JFLD=1,KFIELDS
        ITAG=15000+JFLD
        IPROCHLP=IGETPROCHLP(YD,JFLD)
        IF(IPROCHLP == YIOS%MYPROC) THEN
          IFLD=IFLD+1
          CALL MPL_RECV(NGRIBD(NGSTA(IFLD):),KSOURCE=YD%MIOPROCHLP,KTAG=ITAG,&
           & KOUNT=ILRECV,CDSTRING='IOSTREAM_MIX:READ_RECORD')
          IF(ILRECV == 1) THEN
            YD%LEOF = .TRUE.
            EXIT RLOOP
          ELSE
            NGSTA(IFLD+1) = NGSTA(IFLD)+ILRECV
            YDR%IFIELDS_HAVE=YDR%IFIELDS_HAVE+1
            CALL GSTATS(650,2)
            CALL GRIB_DECODE(YDR,PREC)
            CALL GSTATS(650,3)
          ENDIF
        ENDIF
      ENDDO RLOOP
      CALL GSTATS(650,1)
    ENDIF
  ENDIF
    
  CALL GRIB_DECODE(YDR,PREC)

  IF(YD%LIOUSEHELP) THEN
    CALL GSTATS(648,0)
    IF(YD%LIOPROC) THEN
      INUM=IFIND(YIOS%MYPROC,YD%IOPROCS)
      IF(YD%NUMHLP(INUM) > 1) THEN
        DO JFLD=1,YDR%IFIELDS_IO
          ITAG=16000+JFLD
          IPROCHLP=IGETPROCHLP(YD,JFLD)
          CALL MPL_RECV(IMSG,KSOURCE=IPROCHLP,KTAG=ITAG,&
           & CDSTRING='IOSTREAM_MIX:READ_RECORD')
          YDR%IGRBCODES(JFLD)=IMSG(1)
          YDR%ILEVS(JFLD) = IMSG(2)
          YDR%IHAVEFLD(JFLD) = IPROCHLP
        ENDDO
      ENDIF
    ELSEIF(YD%LIOPROCHLP) THEN
      IFLD=0
      MLOOP:DO JFLD=1,KFIELDS
        ITAG=16000+JFLD
        IPROCHLP=IGETPROCHLP(YD,JFLD)
        IF(IPROCHLP == YIOS%MYPROC) THEN
          IFLD=IFLD+1
          IF(IFLD > YDR%IFIELDS_HAVE) EXIT MLOOP
          IMSG(1)=YDR%IGRBCODES(IFLD)
          IMSG(2)=YDR%ILEVS(IFLD)
          CALL MPL_SEND(IMSG,KDEST=YD%MIOPROCHLP,KTAG=ITAG,&
           & CDSTRING='IOSTREAM_MIX:READ_RECORD')
        ENDIF
      ENDDO MLOOP
    ENDIF
    CALL GSTATS(648,1)
  ENDIF
ENDIF
IF(YD%LIOUSEHELP) CALL GSTATS_BARRIER2(739)
IF(ALLOCATED(IGRIBMSG)) DEALLOCATE(IGRIBMSG)

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:READ_RECORD',1,ZHOOK_HANDLE)

END SUBROUTINE READ_RECORD

!=============================================================
SUBROUTINE GRIB_ENCODE(YDR,PREC,KFIELDS)

!**** *GRIB_ENCODE*  - Encode data in GRIB

! Purpose - To encode data in GRIB

! Explicit arguments :
! --------------------
! YDR  - IO request structure
! PREC - real data
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB),INTENT(IN) :: PREC(:,:)
INTEGER(KIND=JPIM) ,INTENT(IN) :: KFIELDS
INTEGER(KIND=JPIM) :: IERR,JFLD,IGRIBMSGLEN,ILEN,IBOT,ITOP
LOGICAL :: LLGRAD
CHARACTER(LEN=3) :: CLREPR
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_ENCODE',0,ZHOOK_HANDLE)

CALL GSTATS(1878,0)
CALL ALLO_IGRIB(YDR,KFIELDS)
SELECT CASE(YDR%IDATA_TYPE)
CASE(JPSPEC)
  CLREPR = 'SH'
  ILEN = YDR%YSPF%ISPEC2G
CASE(JPGP)
  CLREPR = 'GG'
  ILEN = YDR%YGPF%IGPTOTG
CASE DEFAULT
  CLREPR = 'SH'
  ILEN = YDR%YSPF%ISPEC2G
END SELECT

DO JFLD =1,KFIELDS
  ITOP = -1
  IBOT = -1
  LLGRAD = .FALSE.
  IF(YIOS%LIFS_INTERNAL) THEN
    CALL GRIB_CODE_MESSAGE(YDR%IGRIB_HANDLE,YDR%IGRBCODES(JFLD),YDR%ILEVS(JFLD),&
     & CLREPR,YDR%CLEVTYPE,&
     & YDR%YSPF%ISMAX,LLGRAD,ITOP,IBOT)
  ENDIF
  CALL GRIB_UPDATE_MESSAGE(YDR%IGRIB_HANDLE,YDR%IGRBCODES(JFLD),YDR%ILEVS(JFLD),&
   & CLREPR,YDR%CLEVTYPE,PREC(1:ILEN,JFLD),YDR%YSPF%ISMAX,&
   & LLGRAD,ITOP,IBOT,IGRIBMSGLEN,NGRIBD(NGSTA(JFLD):))
  NGSTA(JFLD+1) = NGSTA(JFLD)+(IGRIBMSGLEN+YIOS%NINTLEN-1)/YIOS%NINTLEN
ENDDO
CALL GSTATS(1878,1)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_ENCODE',1,ZHOOK_HANDLE)

END SUBROUTINE GRIB_ENCODE
!============================================================= 
SUBROUTINE GRIB_DECODE(YDR,PREC)

!**** *GRIB_DECODE*  - Decode GRIB data

! Purpose - Decode GRIB data

! Explicit arguments :
! --------------------
! YDR  - IO request structure
! PREC - real data
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
REAL(KIND=JPRB),INTENT(OUT) :: PREC(:,:)

INTEGER(KIND=JPIM) :: IERR,JFLD,IGRIBMSGLEN,IRET,IVALUES,j
REAL(KIND=JPRB) :: ZHOOK_HANDLE,ZHOOK_HANDLE2
!INTEGER(KIND=JPIB), EXTERNAL :: GETHWM, GETRSS, GETCURHEAP, GETSTK, GETMAXSTK
CHARACTER(LEN=1) :: CLDECODE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_DECODE',0,ZHOOK_HANDLE)
IF(YDR%LINQUIRE) THEN
  CLDECODE = 'I'
ELSE
  CLDECODE = 'D'
ENDIF
CALL GSTATS(1879,0)
DO JFLD =1,YDR%IFIELDS_HAVE
  IF(LGRIBDONE(JFLD)) CYCLE
  IGRIBMSGLEN = NGSTA(JFLD+1)-NGSTA(JFLD)
  CALL IGRIB_NEW_FROM_MESSAGE(YDR%IGRIB_HANDLE,NGRIBD(NGSTA(JFLD):NGSTA(JFLD+1)-1))
  CALL IGRIB_SET_VALUE(YDR%IGRIB_HANDLE,'missingValue',-9999)
  CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KPARAM=YDR%IGRBCODE,KLEV=YDR%ILEV,CDREPRT=YDR%CREPRT)
  IF(TRIM(YDR%CREPRT) == 'sh') THEN
    CALL INQUIRE_GRIB(YDR%IGRIB_HANDLE,KSMAX=YDR%IRESOLI)
  ENDIF
  CALL IGRIB_GET_VALUE(YDR%IGRIB_HANDLE,'numberOfEffectiveValues',IVALUES)
  YDR%IVALUES = IVALUES
  IF(.NOT. YDR%LINQUIRE) THEN
    IF(IVALUES > 0) THEN
      IF(SIZE(PREC(:,JFLD)) < IVALUES) THEN
        WRITE(YIOS%NULERR,*)' SIZE(PREC(:,JFLD) ,IVALUES ', SIZE(PREC(:,JFLD)) ,IVALUES
        CALL ABOR1(' IOSTREAM_MIX:GRIB_DECODE:PREC TO SMALL')
      ENDIF
    ENDIF
    PREC(1:IVALUES,JFLD) = -1.0_JPRB
    IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_GET_VALUES',0,ZHOOK_HANDLE2)
    CALL IGRIB_GET_VALUE(YDR%IGRIB_HANDLE,'values',PREC(1:IVALUES,JFLD))
    IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_GET_VALUES',1,ZHOOK_HANDLE2)
  ENDIF
  YDR%IGRBCODES(JFLD) = YDR%IGRBCODE
  YDR%ILEVS(JFLD) = YDR%ILEV
  LGRIBDONE(JFLD) = .TRUE.
  CALL GRIB_CHECKS(YDR)
ENDDO
CALL GSTATS(1879,1)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_DECODE',1,ZHOOK_HANDLE)

END SUBROUTINE GRIB_DECODE
!============================================================= 
SUBROUTINE GRIB_CHECKS(YDR)

!**** *GRIB_CHECKS*  - Some consistency checks on GRIB header

! Purpose - Check GRIB header info

! Explicit arguments :
! --------------------
! YDR  - IO request structure
!-------------------------------------------------------------------------
IMPLICIT NONE

TYPE(TYPE_IOREQUEST),INTENT(IN) :: YDR

REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_CHECKS',0,ZHOOK_HANDLE)

SELECT CASE(YDR%IDATA_TYPE)
CASE(JPSPEC)
  IF(TRIM(YDR%CREPRT) /= 'sh') THEN
    WRITE(YIOS%NULERR,'(" IOSTREAM_MIX :UNEXPECTED DATA ",&
     & "REPRESENTATION TYPE",A)') TRIM(YDR%CREPRT)
    CALL ABOR1(' IOSTREAM_MIX:INVALID DATA REPRESENTATION TYPE FOR SH')
  ENDIF
  IF(.NOT. YDR%LINTERP .AND. .NOT. YDR%LINTONLY .AND. &
   & YDR%IRESOLI /= YDR%YSPF%ISMAX) THEN
    WRITE(YIOS%NULERR,*)' IOSTREAM_MIX :RESOLUTION OF MODEL ',YDR%YSPF%ISMAX,&
     & ' ,OF INITIAL DATA ',YDR%IRESOLI
    CALL ABOR1(' IOSTREAM_MIX : DATA HAS INCORRECT RESOLUTION')
  ENDIF
CASE(JPGP)
  IF(YDR%LATLONG) THEN
    IF(TRIM(YDR%CREPRT) /= 'regular_ll' .AND. TRIM(YDR%CREPRT) /= 'reduced_ll') THEN
      WRITE(YIOS%NULERR,'(" IOSTREAM_MIX :UNEXPECTED DATA ",&
       & "REPRESENTATION TYPE",A)') TRIM(YDR%CREPRT)
      CALL ABOR1(' IOSTREAM_MIX:INVALID DATA REPRESENTATION TYPE FOR LAT/LONG')
    ENDIF
  ELSE
    IF(TRIM(YDR%CREPRT) /= 'regular_gg' .AND. TRIM(YDR%CREPRT) /= 'reduced_gg') THEN
    WRITE(YIOS%NULERR,'(" IOSTREAM_MIX :UNEXPECTED DATA ",&
       & "REPRESENTATION TYPE",A)') TRIM(YDR%CREPRT)
      CALL ABOR1(' IOSTREAM_MIX:INVALID DATA REPRESENTATION TYPE FOR GG')
    ENDIF
  ENDIF
END SELECT

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_CHECKS',1,ZHOOK_HANDLE)

END SUBROUTINE GRIB_CHECKS
!============================================================= 
SUBROUTINE ALLO_IGRIB(YDR,KFIELDS,KLENGRB)

!**** *ALLO_IGRIB*  - Allocate array to keep GRIB data

! Purpose - Allocate GRIB array

! Explicit arguments :
! --------------------
! YDR  - IO request structure

!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOREQUEST),INTENT(INOUT) :: YDR
INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KLENGRB

INTEGER(KIND=JPIM) :: ILENGRB
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:ALLO_IGRIB',0,ZHOOK_HANDLE)
IF(YDR%LGRIB) THEN
  IF(PRESENT(KLENGRB)) THEN
    ILENGRB = KLENGRB
  ELSEIF(YDR%LINTONLY) THEN
    ILENGRB = YIOS%IMAXGRID+8000
  ELSE    
    SELECT CASE(YDR%IDATA_TYPE)
    CASE(JPSPEC)
      ILENGRB = YDR%YSPF%ISPEC2G+8000
    CASE(JPGP)
      IF(YDR%LATLONG) THEN
        ILENGRB = YIOS%IMAXGRID+8000
      ELSE
      ILENGRB = YDR%YGPF%IGPTOTG+8000
      ENDIF
    CASE DEFAULT
      ILENGRB = YDR%YGPF%IGPTOTG+8000
    END SELECT
  ENDIF
  IF(ALLOCATED(NGRIBD)) THEN
    IF(SIZE(NGRIBD) < ILENGRB*KFIELDS) THEN
      DEALLOCATE(NGRIBD)
      ALLOCATE(NGRIBD(ILENGRB*MAX(YDR%NCHUNKSIZE,KFIELDS)))
      DEALLOCATE(NGRIBMSG)
      ALLOCATE(NGRIBMSG(ILENGRB+1))
    ENDIF
  ELSE
    ALLOCATE(NGRIBD(ILENGRB*MAX(YDR%NCHUNKSIZE,KFIELDS)))
    ALLOCATE(NGRIBMSG(ILENGRB+1))
  ENDIF
  IF(ALLOCATED(NGSTA)) THEN
    IF(SIZE(NGSTA) < KFIELDS+1) THEN
      DEALLOCATE(NGSTA)
      DEALLOCATE(LGRIBDONE)
      ALLOCATE(NGSTA(MAX(YDR%NCHUNKSIZE,KFIELDS)+1))
      ALLOCATE(LGRIBDONE(MAX(YDR%NCHUNKSIZE,KFIELDS)+1))
    ENDIF
  ELSE
    ALLOCATE(NGSTA(MAX(YDR%NCHUNKSIZE,KFIELDS)+1))
    ALLOCATE(LGRIBDONE(MAX(YDR%NCHUNKSIZE,KFIELDS)+1))
  ENDIF
  NGSTA(1) = 1
  NGSTA(2:) = -HUGE(ILENGRB)
  LGRIBDONE(:) = .FALSE.
ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:ALLO_IGRIB',1,ZHOOK_HANDLE)

END SUBROUTINE ALLO_IGRIB
!=============================================================
SUBROUTINE GET_PUT_ARGS(YDR,LDPR,KPRD,LDKR,KKRD,&
 &PR1,PR2,PR3,PR4,KR1,KR2,KR3,KR4)

!**** *GET_PUT_ARGS*  - Check args for IO_PUT or IO_GET

! Purpose - Gather info from arguments

! Explicit arguments :
! --------------------
! YDR  - IO request structure
! LDPR - logical to indicate real args present
! KPRD - dimensions of real args present
! LDKR - logical to indicate integer args present
! KKRD - dimensions of integer args present
! PR1  - real rank 1 array
! PR2  - real rank 2 array
! PR3  - real rank 3 array
! PR4  - real rank 4 array
! KR1  - integer rank 1 array
! KR2  - integer rank 2 array
! KR3  - integer rank 3 array
! KR4  - integer rank 4 array

!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOREQUEST),INTENT(IN) :: YDR
LOGICAL,INTENT(OUT) :: LDPR(4)
INTEGER(KIND=JPIM),INTENT(OUT) :: KPRD(4,4)
LOGICAL,INTENT(OUT) :: LDKR(4)
INTEGER(KIND=JPIM),INTENT(OUT) :: KKRD(4,4)
REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PR1(:)
REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PR2(:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PR3(:,:,:)
REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PR4(:,:,:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KR1(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KR2(:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KR3(:,:,:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KR4(:,:,:,:)

INTEGER(KIND=JPIM) :: IF2,IF3,ILV3,IA2,IA3
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GET_PUT_ARGS',0,ZHOOK_HANDLE)

LDPR(:) = .FALSE.
KPRD(:,:) = 0
IF(PRESENT(PR1)) THEN
  LDPR(1)   = .TRUE.
  KPRD(1,1) = UBOUND(PR1,1)
ENDIF  
IF(PRESENT(PR2)) THEN
  LDPR(2)   = .TRUE.
  KPRD(2,1) = UBOUND(PR2,1)
  KPRD(2,2) = UBOUND(PR2,2)
ENDIF  
IF(PRESENT(PR3)) THEN
  LDPR(3)   = .TRUE.
  KPRD(3,1) = UBOUND(PR3,1)
  KPRD(3,2) = UBOUND(PR3,2)
  KPRD(3,3) = UBOUND(PR3,3)
ENDIF  
IF(PRESENT(PR4)) THEN
  LDPR(4)   = .TRUE.
  KPRD(4,1) = UBOUND(PR4,1)
  KPRD(4,2) = UBOUND(PR4,2)
  KPRD(4,3) = UBOUND(PR4,3)
  KPRD(4,4) = UBOUND(PR4,4)
ENDIF
LDKR(:) = .FALSE.
KKRD(:,:) = 0
IF(PRESENT(KR1)) THEN
  LDKR(1)   = .TRUE.
  KKRD(1,1) = UBOUND(KR1,1)
ENDIF  
IF(PRESENT(KR2)) THEN
  LDKR(2)   = .TRUE.
  KKRD(2,1) = UBOUND(KR2,1)
  KKRD(2,2) = UBOUND(KR2,2)
ENDIF  
IF(PRESENT(KR3)) THEN
  LDKR(3)   = .TRUE.
  KKRD(3,1) = UBOUND(KR3,1)
  KKRD(3,2) = UBOUND(KR3,2)
  KKRD(3,3) = UBOUND(KR3,3)
ENDIF  
IF(PRESENT(KR4)) THEN
  LDKR(4)   = .TRUE.
  KKRD(4,1) = UBOUND(KR4,1)
  KKRD(4,2) = UBOUND(KR4,2)
  KKRD(4,3) = UBOUND(KR4,3)
  KKRD(4,4) = UBOUND(KR4,4)
ENDIF
  
!Checks on arguments

IF(YDR%IDATA_TYPE == JPSPEC .OR. YDR%IDATA_TYPE == JPGP) THEN
  IF(YDR%IDATA_TYPE == JPSPEC ) THEN
    IA2 = 2
    IF2 = 2
    IA3 = 3
    IF3 = 3
    ILV3 = 1
  ELSE
    IA2 = 3
    IF2 = 2
    IF3 = 3
    IA3 = 4
    ILV3 = 2
  ENDIF
  IF(YDR%IDATA_TYPE == JPGP) THEN
    IF(LDPR(IA2)) THEN
      IF(YDR%YMDL_2D%NUMFLDS /= KPRD(IA2,IF2)) THEN
        WRITE(YIOS%NULERR,*) 'YDR%YMDL_2D%NUMFLDS  KPRD(IA2,IF2) ',&
         & YDR%YMDL_2D%NUMFLDS,KPRD(IA2,IF2),IA2,IF2
        CALL ABOR1('IOSTREAM_MIX:IO_GET_PUT_ARGS - YDR%YMDL_2D%NUMFLDS /= KPRD')
      ENDIF
    ELSE
      IF(YDR%YMDL_2D%NUMFLDS /= 0) &
       & CALL ABOR1('IOSTREAM_MIX:IO_GET_PUT_ARGS - 2D PR MISSING')
    ENDIF
  ENDIF
  IF(LDPR(IA3)) THEN
    IF(YDR%YMDL_3D%NUMFLDS /= KPRD(IA3,IF3)) THEN
      WRITE(YIOS%NULERR,*) 'YDR%YMDL_3D%NUMFLDS,KPRD(IA3,IF3) ',&
       & YDR%YMDL_3D%NUMFLDS,KPRD(IA3,IF3),IA3,IF3
      CALL ABOR1('IOSTREAM_MIX:IO_GET_PUT_ARGS - YDR%YMDL_3D%NUMFLDS /= IPR')
    ENDIF
  ENDIF
ENDIF

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GET_PUT_ARGS',1,ZHOOK_HANDLE)
END SUBROUTINE GET_PUT_ARGS
!=============================================================
SUBROUTINE ASSIGN_IOPROC(YD,KIOPROC,KMYCOUNT,KFLDPROC)

!**** *ASSIGN_IOPROC*  - Assign IO processor to fields

! Purpose - Assign IO processor to fields in round-robin fashion

! Explicit arguments :
! --------------------
! YD   - IO stream structure
! KIOPROC - IO processor for field
! KMYCOUNT - number of fields my processor is responsible for
!-------------------------------------------------------------------------
IMPLICIT NONE
TYPE(TYPE_IOSTREAM),INTENT(IN) :: YD
INTEGER(KIND=JPIM),INTENT(OUT) :: KIOPROC(:)
INTEGER(KIND=JPIM),INTENT(OUT) :: KMYCOUNT
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPROC(:)

INTEGER(KIND=JPIM) :: JF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:ASSIGN_IOPROC',0,ZHOOK_HANDLE)
KMYCOUNT = 0
IF(PRESENT(KFLDPROC)) THEN
  IF(SIZE(KFLDPROC) < SIZE(KIOPROC)) &
   & CALL ABOR1('IOSTREAM_MIX:ASSIGN_IOPROC - KFLDPROC TOO SMALL')
  DO JF=1,SIZE(KIOPROC)
    IF(IFIND(KFLDPROC(JF),YD%IOPROCS(:)) == 0) &
     & CALL ABOR1('IOSTREAM_MIX:ASSIGN_IOPROC - KFLDPROC PROC NOT IN YD%IOPROCS')
    KIOPROC(JF) = KFLDPROC(JF)
    IF(KIOPROC(JF) == YIOS%MYPROC) KMYCOUNT = KMYCOUNT+1
  ENDDO
ELSE
  DO JF=1,SIZE(KIOPROC)
    KIOPROC(JF) = YD%IOPROCS(MOD(JF-1,YD%NUMIOPROCS)+1)
    IF(KIOPROC(JF) == YIOS%MYPROC) KMYCOUNT = KMYCOUNT+1
  ENDDO
ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:ASSIGN_IOPROC',1,ZHOOK_HANDLE)

END SUBROUTINE ASSIGN_IOPROC
!======================================================================
FUNCTION IFIND(KVAL,KARRAY)

!**** *IFIND*  - Find position of value in array

! Purpose - Find position of value in array (returns 0 if not found)

! Explicit arguments :
! --------------------
! KVAL - value
! KARRAY - array
!-------------------------------------------------------------------------
IMPLICIT NONE
INTEGER(KIND=JPIM),INTENT(IN) :: KVAL
INTEGER(KIND=JPIM),INTENT(IN) :: KARRAY(:)

INTEGER(KIND=JPIM) :: IFIND
INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IFIND',0,ZHOOK_HANDLE)
IFIND = 0
DO J=1,SIZE(KARRAY)
  IF(KVAL == KARRAY(J)) THEN
    IFIND = J
    EXIT
  ENDIF
ENDDO
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IFIND',1,ZHOOK_HANDLE)

END FUNCTION IFIND
!=================================================================
FUNCTION IFINDR(PVAL,PARRAY)

!**** *IFINDR*  - Find position of value in array

! Purpose - Find position of value in array (returns 0 if not found)

! Explicit arguments :
! --------------------
! PVAL - value
! PARRAY - array
!-------------------------------------------------------------------------
REAL(KIND=JPRB),INTENT(IN) :: PVAL
REAL(KIND=JPRB),INTENT(IN) :: PARRAY(:)

INTEGER(KIND=JPIM) :: IFINDR
INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IFINDR',0,ZHOOK_HANDLE)
IFINDR = 0
DO J=1,SIZE(PARRAY)
  IF(PVAL == PARRAY(J)) THEN
    IFINDR = J
    EXIT
  ENDIF
ENDDO
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IFINDR',1,ZHOOK_HANDLE)

END FUNCTION IFINDR

!======================================================================

FUNCTION IFIND2(KVAL1,KVAL2,KARRAY1,KARRAY2)

!**** *IFIND2*  - Find position of values in 2 arrays

! Purpose - Find position of values in arrays (returns 0 if not found)

! Explicit arguments :
! --------------------
! KVAL1 - value 1
! KVAL2 - value 2
! KARRAY1 - array 1
! KARRAY1 - array 2
!-------------------------------------------------------------------------
INTEGER(KIND=JPIM),INTENT(IN) :: KVAL1,KVAL2
INTEGER(KIND=JPIM),INTENT(IN) :: KARRAY1(:)
INTEGER(KIND=JPIM),INTENT(IN) :: KARRAY2(:)

INTEGER(KIND=JPIM) :: IFIND2
INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IFIND2',0,ZHOOK_HANDLE)
IFIND2 = 0
DO J=1,SIZE(KARRAY1)
  IF(KVAL1 == KARRAY1(J) .AND. KVAL2 == KARRAY2(J)) THEN
    IFIND2 = J
    EXIT
  ENDIF
ENDDO
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IFIND2',1,ZHOOK_HANDLE)

END FUNCTION IFIND2
!======================================================================

FUNCTION IGETHLP(YD,KFLD)

!**** *IFIND2*  - Find position of values in 2 arrays

! Purpose - Find position of values in arrays (returns 0 if not found)

! Explicit arguments :
! --------------------
! KFLD - value 1
!-------------------------------------------------------------------------
TYPE(TYPE_IOSTREAM),INTENT(IN) :: YD
INTEGER(KIND=JPIM),INTENT(IN)  :: KFLD

INTEGER(KIND=JPIM) :: IGETHLP,INUM
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IGETHLP',0,ZHOOK_HANDLE)
IGETHLP = 1
IF(YD%LIOPROC) THEN
  INUM=IFIND(YIOS%MYPROC,YD%IOPROCS)
  IF(YD%NUMHLP(INUM) > 1) THEN
    IGETHLP=1+MOD(KFLD-1,YD%NUMHLP(INUM)-1)+1
  ENDIF
ELSEIF(YD%LIOPROCHLP) THEN
  INUM=IFIND(YD%MIOPROCHLP,YD%IOPROCS)
  IGETHLP=1+MOD(KFLD-1,YD%NUMHLP(INUM)-1)+1
ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IGETHLP',1,ZHOOK_HANDLE)

END FUNCTION IGETHLP
!======================================================================

FUNCTION IGETPROCHLP(YD,KFLD,KPROC)

!**** *IFIND2*  - Find position of values in 2 arrays

! Purpose - Find position of values in arrays (returns 0 if not found)

! Explicit arguments :
! --------------------
! KFLD - value 1
!-------------------------------------------------------------------------
TYPE(TYPE_IOSTREAM),INTENT(IN) :: YD
INTEGER(KIND=JPIM),INTENT(IN)  :: KFLD
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KPROC

INTEGER(KIND=JPIM) :: INUM,IGETPROCHLP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IGETPROCHLP',0,ZHOOK_HANDLE)

IF(PRESENT(KPROC)) THEN
  INUM=IFIND(KPROC,YD%IOPROCS)
  IF(YD%NUMHLP(INUM) > 1) THEN
    IGETPROCHLP=YD%IOPROCSHLP(INUM,1+MOD(KFLD-1,YD%NUMHLP(INUM)-1)+1)
  ELSE
    IGETPROCHLP=KPROC
  ENDIF
ELSE
  IGETPROCHLP = -99
  IF(YD%LIOPROC) THEN
    INUM=IFIND(YIOS%MYPROC,YD%IOPROCS)
    IF(YD%NUMHLP(INUM) > 1) THEN
      IGETPROCHLP=YD%IOPROCSHLP(INUM,1+MOD(KFLD-1,YD%NUMHLP(INUM)-1)+1)
    ELSE
      IGETPROCHLP = YD%IOPROCSHLP(INUM,1)
    ENDIF
  ELSEIF(YD%LIOPROCHLP) THEN
    INUM=IFIND(YD%MIOPROCHLP,YD%IOPROCS)
    IGETPROCHLP=YD%IOPROCSHLP(INUM,1+MOD(KFLD-1,YD%NUMHLP(INUM)-1)+1)
  ENDIF
ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:IGETPROCHLP',1,ZHOOK_HANDLE)

END FUNCTION IGETPROCHLP
!============================================================= 
SUBROUTINE GATH_GRID_FP(PGPG,KFGATHG,KTO,PGP)

!**** *GATH_GRID_FP*  - Gather grid-point fields

! Purpose - Gather grid-point fields distributed with "Full-Pos distribution"

! Explicit arguments :
! --------------------
! PGPG - global grid-point fields
! KFGATHG - number of global grid-point fields
! KTO - processor(s) to which to send data
! PGP - local grid-point fields
! 
!-------------------------------------------------------------------------
IMPLICIT NONE
REAL(KIND=JPRB)    , INTENT(OUT) :: PGPG(:,:)
INTEGER(KIND=JPIM) , INTENT(IN)  :: KFGATHG
INTEGER(KIND=JPIM) , INTENT(IN)  :: KTO(:)
REAL(KIND=JPRB)    , INTENT(IN)  :: PGP(:,:,:)
REAL(KIND=JPRB)    :: ZGP(YIOS%NFPRGPLX,KFGATHG)
REAL(KIND=JPRB),ALLOCATABLE :: ZRCV(:,:,:)
INTEGER(KIND=JPIM) :: ISREQ(KFGATHG),IPT(YIOS%NFPRGPG)
INTEGER(KIND=JPIM) :: JFLD, JJ, ILENR0(YIOS%NPROC), IRCV,IFLD,ITO,JROC,ITAG
LOGICAL :: LLSAME
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GATH_GRID_FP',0,ZHOOK_HANDLE)
ITAG=11000
IF(UBOUND(KTO,1) < KFGATHG) THEN
  CALL ABOR1('IOSTREAM_MIX:GATH_GRID_FP: KTO TOO SHORT!')
ENDIF
IF(YIOS%NFPRGPG == YIOS%NUNDEF)  CALL ABOR1('IOSTREAM_MIX:GATH_GRID_FP: YIOS%NFPRGPG NOT DEFINED')
IF(.NOT.ASSOCIATED(YIOS%NUMPROCFP)) CALL ABOR1('IOSTREAM_MIX:GATH_GRID_FP: YIOS%NUMPROCFP NOT DEFINED')
ILENR0(:) = 0
DO JJ=1,YIOS%NFPRGPG
  IRCV = YIOS%NUMPROCFP(JJ)
  ILENR0(IRCV) = ILENR0(IRCV)+1
  IPT(JJ) = ILENR0(IRCV)
ENDDO
LLSAME = .TRUE.
ITO = KTO(1)
DO JFLD=2,KFGATHG
  IF(KTO(JFLD) /= ITO) THEN
    LLSAME = .FALSE.
    EXIT
  ENDIF
ENDDO
IFLD = 0
DO JFLD=1,KFGATHG
  IF(KTO(JFLD) == YIOS%MYPROC) THEN
    IFLD = IFLD+1
  ENDIF
ENDDO
ALLOCATE(ZRCV(YIOS%NFPRGPLX,IFLD,YIOS%NPROC))
CALL GSTATS_BARRIER(728)
CALL GSTATS(633,0)
IF(LLSAME) THEN
  DO JFLD=1,KFGATHG
    ZGP(1:SIZE(PGP,1),JFLD) = PGP(1:SIZE(PGP,1),JFLD,1)
  ENDDO
  CALL MPL_SEND(ZGP,KDEST=KTO(1),&
   & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISREQ(1), &
   & KTAG=ITAG,CDSTRING='IOSTREAM_MIX:GATH_GRID_FP')
ELSE
  DO JFLD=1,KFGATHG
    CALL MPL_SEND(PGP(:,JFLD,1),KDEST=KTO(JFLD),&
     & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISREQ(JFLD), &
     & KTAG=ITAG+JFLD,CDSTRING='IOSTREAM_MIX:GATH_GRID_FP')
  ENDDO
ENDIF
IF (LLSAME) THEN
  IFLD = 0
  IF(KTO(1) == YIOS%MYPROC) THEN
    IFLD = KFGATHG
    DO JROC=1,YIOS%NPROC
      IRCV = JROC
      CALL MPL_RECV(ZRCV(:,:,IRCV),  &
       & KSOURCE=IRCV,KTAG=ITAG,CDSTRING='IOSTREAM_MIX:GATH_GRID_FP')
    ENDDO
  ENDIF
  CALL MPL_WAIT(ZGP(:,1),KREQUEST=ISREQ(1), &
   & CDSTRING='IOSTREAM_MIX:GATH_GRID_FP')
ELSE
  IFLD = 0
  DO JFLD=1,KFGATHG
    IF(KTO(JFLD) == YIOS%MYPROC) THEN
      IFLD = IFLD+1
      DO JROC=1,YIOS%NPROC
        IRCV = JROC
        CALL MPL_RECV(ZRCV(:,IFLD,IRCV),  &
         & KSOURCE=IRCV,KTAG=ITAG+JFLD,CDSTRING='IOSTREAM_MIX:GATH_GRID_FP')
      ENDDO
    ENDIF
  ENDDO
  CALL MPL_WAIT(PGP(:,1,1),KREQUEST=ISREQ(:), &
   & CDSTRING='IOSTREAM_MIX:GATH_GRID_FP')
ENDIF
CALL GSTATS(633,1)
CALL GSTATS_BARRIER2(728)

CALL GSTATS(1482,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JJ)
DO JFLD=1,IFLD
    DO JJ=1,YIOS%NFPRGPG
      PGPG(JJ,JFLD) = ZRCV(IPT(JJ),JFLD,YIOS%NUMPROCFP(JJ))
    ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1482,1)
DEALLOCATE(ZRCV)

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GATH_GRID_FP',1,ZHOOK_HANDLE)
END SUBROUTINE GATH_GRID_FP
!======================================================================
SUBROUTINE INQUIRE_GRIB(KGRIB_HANDLE,KPARAM,KLEV,KSMAX,CDREPRT,KLATS,KLONS,PLATS,&
 & KDATE,KTIME,KSTEP,KLEVTYP,KFLEV,PVALH,PVBH,PA,PB,KPTS,&
 & KSVCOMP,KRITZ1,KRITZ2,KNUMB)

!**** *INQUIRE_GRIB*  - Find info from GRIB header

! Purpose - Find info from GRIB header

! Explicit arguments :
! --------------------
! KRIB_HANDLE - Grib API handle
! KPARAM  - GRIB parameter number
! KLEV    - level
! KSMAX   - spectral truncation
! CDREPRT  - representation type (spectral, gridpoint)
! KLATS   - number of latitude rows
! KLONS   - number of points on each latitude row
! KPTS    - total number of points 
! PLATS   - latitude of each row [radians]
! KDATE   - date of data (yyyymmdd)
! KTIME   - time of data (seconds)
! KSTEP   - time of fc (seconds)
! KLEVTYP - level type (model,pressure....)
! PA, PB  - pressure on level is given by p = PA + ps*PB where ps is
!           surface pressure
!-------------------------------------------------------------------------

IMPLICIT NONE
INTEGER(KIND=JPIM),INTENT(IN) :: KGRIB_HANDLE

INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPARAM
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KLEV
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSMAX
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(OUT) :: CDREPRT
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KLATS
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KLONS(:)
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PLATS(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPTS
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KDATE
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KTIME
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSTEP
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KLEVTYP
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KFLEV
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSVCOMP
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KRITZ1
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KRITZ2
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KNUMB
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PVALH(0:)
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PVBH (0:)
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PA
REAL   (KIND=JPRB),OPTIONAL,INTENT(OUT) :: PB

INTEGER(KIND=JPIM) :: ITIME
INTEGER(KIND=JPIM) :: ILATS,JLAT, IPAR, IFLEV
CHARACTER(LEN=32)  :: CLVAL
INTEGER(KIND=JPIM) :: IVAL,ILONS,INP,ISP,IPLPRESENT,ILEV,IVAL2
REAL   (KIND=JPRB) :: ZDTOR, ZDLAT,ZNP,ZINCJ
REAL   (KIND=JPRB),ALLOCATABLE :: ZVALS(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: IREDGRID(:)
REAL(KIND=JPRB)    :: ZHOOK_HANDLE

!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:INQUIRE_GRIB',0,ZHOOK_HANDLE)

IF(PRESENT(KDATE)) CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'dataDate',KDATE)
IF(PRESENT(KTIME)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'dataTime',ITIME)
  KTIME = (ITIME/100)*3600+MOD(ITIME,100)*60
ENDIF
IF(PRESENT(KSTEP)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'step',IVAL)
  KSTEP=IVAL*3600
ENDIF
IF(PRESENT(KPARAM)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'ifsParam',IVAL)
  KPARAM = IVAL
!!$  ITABLE = YDR%YGRBH%NSEC1(1)
!!$  IF(ITABLE == 162) KPARAM = KPARAM + 162000
!!$  IF(ITABLE == 210) KPARAM = KPARAM + 210000
!!$  IF(ITABLE == 211) KPARAM = KPARAM + 210000
ENDIF

IF(PRESENT(KLEVTYP)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'indicatorOfTypeOfLevel',IVAL)
  KLEVTYP = IVAL
ENDIF
IF(PRESENT(KFLEV)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfVerticalCoordinateValues',IVAL)
  KFLEV = IVAL/2-1
ENDIF
IF(PRESENT(PVALH)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfVerticalCoordinateValues',IVAL)
  IFLEV = IVAL/2-1
  IF(UBOUND(PVALH,1) < IFLEV) &
   & CALL ABOR1 ('IOSTEAM:INQUIRE_GRIB - PVALH TOO SMALL')
  ALLOCATE(ZVALS(2*(IFLEV+1)))
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'pv',ZVALS)
  PVALH(0:IFLEV) =  ZVALS(1:IFLEV+1)
  DEALLOCATE(ZVALS)
ENDIF
IF(PRESENT(PVBH)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfVerticalCoordinateValues',IVAL)
  IFLEV = IVAL/2-1
  IF(UBOUND(PVBH,1) < IFLEV) &
   & CALL ABOR1 ('IOSTEAM:INQUIRE_GRIB - PVBH TOO SMALL')
  ALLOCATE(ZVALS(2*(IFLEV+1)))
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'pv',ZVALS)
  PVBH(0:IFLEV) =  ZVALS(IFLEV+2:2*(IFLEV+1))
  DEALLOCATE(ZVALS)
ENDIF
IF(PRESENT(KLEV)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'ifsParam',IPAR)
  IF(IPAR == NGRBBTMP) THEN                 ! TOVS channel number
    CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'channelNumber',IVAL)
  ELSE
!    CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'indicatorOfTypeOfLevel',IVAL2)
    CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'level',IVAL)
  ENDIF
  KLEV = IVAL
ENDIF

IF(PRESENT(KSVCOMP)) THEN
!  IF(YDR%YGRBH%NSEC1(37) /= 9) &
!   & CALL ABOR1('IOSTREAM_MIX:INQUIRE_GRIB - KSVCOMP ONLY IN LOCAL GRIB 9')
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfSingularVectorsComputed',KSVCOMP)
ENDIF
IF(PRESENT(KRITZ1)) THEN
!  IF(YDR%YGRBH%NSEC1(37) /= 9) &
!   & CALL ABOR1('IOSTREAM_MIX:INQUIRE_GRIB - KRITZ1 ONLY IN LOCAL GRIB 9')
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'NINT_LOG10_RITZ',KRITZ1)
!  KRITZ1 = YDR%YGRBH%NSEC1(54)
ENDIF
IF(PRESENT(KRITZ2)) THEN
!  IF(YDR%YGRBH%NSEC1(37) /= 9) &
!   & CALL ABOR1('IOSTREAM_MIX:INQUIRE_GRIB - KRITZ2 ONLY IN LOCAL GRIB 9')
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'NINT_RITZ_EXP',KRITZ2)
!  KRITZ2 = YDR%YGRBH%NSEC1(55)
ENDIF
IF(PRESENT(KNUMB)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'forecastOrSingularVectorNumber',KNUMB)
!  KNUMB = YDR%YGRBH%NSEC1(42)
ENDIF

IF(PRESENT(CDREPRT)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'gridType',CDREPRT)
ENDIF

!Grid INFO
IF(PRESENT(KLATS) .OR. PRESENT(KLONS) .OR. PRESENT(PLATS) .OR. &
 & PRESENT(KPTS) ) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'gridType',CLVAL)
  IF ( TRIM(CLVAL) /= 'sh' ) THEN
    CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfPointsAlongAMeridian',ILATS)
    IF(PRESENT(KLATS)) KLATS = ILATS
    IF(PRESENT(KLONS) .OR. PRESENT(PLATS) .OR. PRESENT(KPTS) ) THEN
      IF(PRESENT(KLONS)) THEN
        IF(SIZE(KLONS) < ILATS) &
         & CALL ABOR1('IOSTREAM_MIX:INQUIRE_GRIB - KLONS TOO SMALL')
      ENDIF
      IF(PRESENT(PLATS)) THEN
        IF(SIZE(PLATS) < ILATS) &
         & CALL ABOR1('IOSTREAM_MIX:INQUIRE_GRIB - PLATS TOO SMALL')
      ENDIF
      ZDTOR = YIOS%RPI/180._JPRB * 0.001_JPRB
      IF (TRIM(CLVAL) == 'regular_ll' .OR. TRIM(CLVAL) == 'reduced_ll') THEN ! Lat long grid
        CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfPointsAlongAParallel',ILONS)
        IF(PRESENT(KLONS)) KLONS(:) = ILONS
        IF(PRESENT(KPTS))  KPTS = ILATS*ILONS
        IF(PRESENT(PLATS))THEN
          CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'latitudeOfFirstGridPointInDegrees',ZNP)
          CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'jDirectionIncrementInDegrees',ZINCJ)
          DO JLAT=1,ILATS
            PLATS(JLAT)=YIOS%RPI/180._JPRB*(ZNP-(JLAT-1)*ZINCJ)
          ENDDO
!!$          DO JLAT=1,ILATS
!!$            PLATS(JLAT)=ZDTOR*&
!!$             & (ZNP-(JLAT-1)*ISEC2(10))
!!$          ENDDO
        ENDIF
      ELSEIF (TRIM(CLVAL) == 'regular_gg' .OR. TRIM(CLVAL) == 'reduced_gg') THEN ! Gaussian grid
        CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'latitudeOfFirstGridPoint',INP)
        CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'latitudeOfLastGridPoint',ISP)
        ZDLAT = ZDTOR*REAL(ISP-INP,JPRB) &
         & /REAL(ILATS-1,JPRB)
        IF(PRESENT(KLONS)) THEN
          CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'PLPresent',IPLPresent)
          IF (IPLPresent == 0) THEN
            CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfPointsAlongAParallel',ILONS)
            KLONS(:) = ILONS
            ELSE
            CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'pl',KLONS)
            ENDIF
        ENDIF
        IF(PRESENT(KPTS)) THEN
          CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'PLPresent',IPLPresent)
          IF (IPLPresent == 0) THEN
            CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfPointsAlongAParallel',ILONS)
            KPTS = ILONS*ILATS
            ELSE
            ALLOCATE(IREDGRID(ILATS))
            CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'pl',IREDGRID)
            KPTS = SUM(IREDGRID(1:ILATS))
            DEALLOCATE(IREDGRID)
            ENDIF
        ENDIF
        IF(PRESENT(PLATS))THEN
          DO JLAT=1,ILATS
            PLATS(JLAT) = ZDTOR*INP + (JLAT-1)*ZDLAT
          ENDDO
        ENDIF
      ENDIF
    ENDIF
  ELSE
    CALL ABOR1('IOSTREAMGRID TYPE NOT RECOGNIZED')
  ENDIF
ENDIF

IF(PRESENT(PA) .AND. PRESENT(PB)) THEN
!!$  IF(.NOT. YDR%IDATA_TYPE == JPGP) &
!!$   & CALL ABOR1('IOSTREAM_MIX:INQUIRE_GRIB - PA AND PB ONLY FOR G.P.')
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'ifsParam',IPAR)
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'indicatorOfTypeOfLevel',IVAL)
  IF(IPAR == NGRBBTMP) THEN
    CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'channelNumber',IVAL2)
    PA = IVAL2               ! TOVS channel number
    PB = 0.0_JPRB
  ELSEIF (IVAL == 1) THEN    ! Surface
    PA = 1.0_JPRB
    PB = 0.0_JPRB
  ELSEIF (IVAL == 100) THEN  ! Pressure level
    call abor1('IOSTREAM:INQUIRE_GRIB - Pressure level')
!!$    PA = YDR%YGRBH%NSEC1(8)*100._JPRB
!!$    PB = 0.0_JPRB
  ELSEIF (IVAL == 109) THEN  ! Model level
    CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'numberOfVerticalCoordinateValues',IVAL2)
    CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'level',ILEV)
    IF (IVAL2 == 0) THEN
      PA = 0.5_JPRB*(YIOS%VAH(ILEV-1)+YIOS%VAH(ILEV  ))
      PB = 0.5_JPRB*(YIOS%VBH(ILEV-1)+YIOS%VBH(ILEV  ))
    ELSE
      IFLEV = IVAL2/2-1
      ALLOCATE(ZVALS(2*(IFLEV+1)))
      CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'pv',ZVALS)
      PA = 0.5_JPRB*(ZVALS(ILEV)+ZVALS(ILEV+1))
      PB = 0.5_JPRB*(ZVALS(ILEV+IVAL2/2)+ZVALS(ILEV+1+IVAL2/2))
      DEALLOCATE(ZVALS)
    ENDIF
  ENDIF
ENDIF  

IF(PRESENT(KSMAX)) THEN
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'gridType',CLVAL)
  IF ( TRIM(CLVAL) /= 'sh' ) &
   & CALL ABOR1('IOSTREAM_MIX:INQUIRE_GRIB - KSMAX ONLY FOR SPECTRAL')
  CALL IGRIB_GET_VALUE(KGRIB_HANDLE,'pentagonalResolutionParameterJ',IVAL)
  KSMAX = IVAL
ENDIF
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:INQUIRE_GRIB',1,ZHOOK_HANDLE)

END SUBROUTINE INQUIRE_GRIB
!======================================================================
SUBROUTINE COPYGP_GLOB2LOC(PGLOB,PLOC,KPROMA,KPTS)

!**** *COPYGP*  - Copy grid-point array

! Purpose - Copy grid-point array

! Explicit arguments :
! --------------------
! PGLOB - input array
! PLOC  - output array
! KPROMA - blocking factor
! KPTS - number of points
!-------------------------------------------------------------------------

IMPLICIT NONE
REAL(KIND=JPRB),INTENT(IN)     :: PGLOB(:,:)
REAL(KIND=JPRB),INTENT(OUT)    :: PLOC(:,:,:)
INTEGER(KIND=JPIM),INTENT(IN)  :: KPROMA
INTEGER(KIND=JPIM),INTENT(IN)  :: KPTS

INTEGER(KIND=JPIM) :: IFIELDS,IBL,JFLD,JKGLO,JROF 
REAL(KIND=JPRB)    :: ZHOOK_HANDLE

!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:COPYGP_GLOB2LOC',0,ZHOOK_HANDLE)

IF(KPROMA*SIZE(PLOC,3) < KPTS) &
 & CALL ABOR1('IOSTREAM_MIX:COPYGP_GLOB2LOC-PLOC TOO SMALL')
IFIELDS = MIN(SIZE(PGLOB,2),SIZE(PLOC,2))
CALL GSTATS(1477,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JKGLO,IBL,JROF)
DO JKGLO=1,KPTS,KPROMA
  IBL = (JKGLO-1)/KPROMA+1
  DO JFLD=1,IFIELDS
    DO JROF=1,MIN(KPROMA,KPTS-JKGLO+1)
      PLOC(JROF,JFLD,IBL) =  PGLOB(JKGLO+JROF-1,JFLD)
    ENDDO
  ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1477,1)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:COPYGP_GLOB2LOC',1,ZHOOK_HANDLE)
END SUBROUTINE COPYGP_GLOB2LOC
!======================================================================
SUBROUTINE COPYGP_LOC2GLOB(PGLOB,PLOC,KPROMA,KPTS)

!**** *COPYGP*  - Copy grid-point array

! Purpose - Copy grid-point array

! Explicit arguments :
! --------------------
! PGLOB - global array
! PLOC  - local array
! KPROMA - blocking factor
! KPTS - number of points
!-------------------------------------------------------------------------

IMPLICIT NONE
REAL(KIND=JPRB),INTENT(OUT)  :: PGLOB(:,:)
REAL(KIND=JPRB),INTENT(IN)   :: PLOC(:,:,:)
INTEGER(KIND=JPIM),INTENT(IN)  :: KPROMA
INTEGER(KIND=JPIM),INTENT(IN)  :: KPTS

INTEGER(KIND=JPIM) :: IFIELDS,IBL,JFLD,JKGLO,JROF 
REAL(KIND=JPRB)    :: ZHOOK_HANDLE

!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:COPYGP_LOC2GLOB',0,ZHOOK_HANDLE)

IF(KPROMA*SIZE(PLOC,3) < KPTS) &
 & CALL ABOR1('IOSTREAM_MIX:COPYGP_LOC2GLOB-PLOC TOO SMALL')
IFIELDS = MIN(SIZE(PGLOB,2),SIZE(PLOC,2))
CALL GSTATS(1478,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JKGLO,IBL,JROF)
DO JKGLO=1,KPTS,KPROMA
  IBL = (JKGLO-1)/KPROMA+1
  DO JFLD=1,IFIELDS
    DO JROF=1,MIN(KPROMA,KPTS-JKGLO+1)
      PGLOB(JKGLO+JROF-1,JFLD) = PLOC(JROF,JFLD,IBL)
    ENDDO
  ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1478,1)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:COPYGP_LOC2GLOB',1,ZHOOK_HANDLE)
END SUBROUTINE COPYGP_LOC2GLOB
!=============================================================
SUBROUTINE GRIB_UPDATE_MESSAGE(KGRIB_HANDLE,KGRIBCD,KLEV,CDREPR,CDLTYPE,PDATA,&
 & KSMAX,LDGRAD,KTOP,KBOT,KGRIB_LEN,KGRIB)
IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KGRIB_HANDLE
INTEGER(KIND=JPIM),INTENT(IN)    :: KGRIBCD
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
CHARACTER         ,INTENT(IN)    :: CDREPR*(*)
CHARACTER         ,INTENT(IN)    :: CDLTYPE*(*)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDATA(:)
INTEGER(KIND=JPIM),INTENT(IN)    :: KSMAX 
LOGICAL           ,INTENT(IN)    :: LDGRAD
INTEGER(KIND=JPIM),INTENT(IN)    :: KTOP
INTEGER(KIND=JPIM),INTENT(IN)    :: KBOT
INTEGER(KIND=JPIM),INTENT(INOUT) :: KGRIB_LEN
INTEGER(KIND=JPIM),INTENT(OUT)   :: KGRIB(:)

INTEGER(KIND=JPIM) :: ISMAX,ISPEC2,IBITSSH,ISTRUNC,ILENINT
REAL(KIND=JPRB)    :: ZP,ZBETA0,ZBETA1
REAL(KIND=JPRB)    :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_UPDATE_MESSAGE',0,ZHOOK_HANDLE)
IF(CDREPR == 'SH') THEN
  ISMAX=KSMAX
  ISPEC2 = (ISMAX+1)*(ISMAX+2)
  IBITSSH=16
  IF(KSMAX>= 213) THEN
    ISTRUNC = 20
  ELSE
    ISTRUNC = MIN(10,KSMAX)
  ENDIF
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'numberOfBitsContainingEachPackedValue',IBITSSH)
  IF(KGRIBCD == NGRBZ   .AND.CDLTYPE(1:2) == 'ML') THEN
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'laplacianOperator',0.5_JPRB)
  ELSEIF (KGRIBCD == NGRBLNSP.AND.CDLTYPE(1:2) == 'ML' .AND. .NOT. LDGRAD) THEN
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'laplacianOperator',0.5_JPRB)
  ELSEIF(ISTRUNC < ISMAX ) THEN
    CALL FITSPECTRUM(ISMAX,ISPEC2,PDATA,ISTRUNC,ZBETA0,ZBETA1)
    ZP        = -ZBETA1
    ZP        = MAX(-9.9_JPRB,MIN(9.9_JPRB,ZP))
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'laplacianOperator',ZP)
  ELSE
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'laplacianOperator',0.0_JPRB)
  ENDIF
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'subSetJ',ISTRUNC)
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'subSetK',ISTRUNC)
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'subSetM',ISTRUNC)
ELSEIF(CDREPR == 'GG') THEN
  IF(KGRIBCD == NGRBCC) THEN
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'numberOfBitsContainingEachPackedValue',8)
  ELSEIF(KGRIBCD == NGRBSD.OR.KGRIBCD == NGRBFSR) THEN
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'numberOfBitsContainingEachPackedValue',24)
  ELSEIF(KGRIBCD == NGRBCLWC.AND.CDLTYPE(1:2) == 'PL') THEN
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'numberOfBitsContainingEachPackedValue',12)
  ELSEIF(KGRIBCD == NGRBCIWC.AND.CDLTYPE(1:2) == 'PL') THEN
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'numberOfBitsContainingEachPackedValue',12)
  ELSE
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'numberOfBitsContainingEachPackedValue',16)
  ENDIF
ELSE
  WRITE(YIOS%NULOUT,'('' PREGRBENC - REPR .TYPE NOT SUPPORTED '')')
  CALL ABOR1('PREGRBENC: ABOR1 CALLED')
ENDIF

!*        1.2   LEVEL(S)
IF(CDLTYPE(1:2) == 'SF') THEN
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'typeOfLevel','surface')
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'level',0)
  IF(KTOP >=0 .AND. KBOT >=0) THEN
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'typeOfLevel','depthBelowLandLayer')
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'topLevel',KTOP)
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'bottomLevel',KBOT)
  ENDIF
ELSEIF(CDLTYPE(1:2) == 'ML') THEN
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'typeOfLevel','hybrid')
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'level',KLEV)
ELSEIF(CDLTYPE(1:2) == 'PL') THEN
  IF(((KLEV >= 100).AND.(MOD(KLEV,100).EQ.0)).OR.(KLEV>65500)) THEN
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'typeOfLevel','isobaricInhPa')
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'level',KLEV/100)
  ELSE
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'typeOfLevel','isobaricInPa')
    CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'level',KLEV)
  ENDIF
ELSEIF(CDLTYPE(1:2) == 'PV') THEN
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'typeOfLevel','potentialVorticity')
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'level',KLEV)
ELSEIF(CDLTYPE(1:2) == 'TH') THEN
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'typeOfLevel','theta')
  CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'level',KLEV)
ELSE
  CALL ABOR1('GRIB_CODE_MESSAGE: LEVEL TYPE NOT SUPPORTED ')
ENDIF
!        1.3   PARAMETER

CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'ifsParam',KGRIBCD)

! Values
CALL IGRIB_SET_VALUE(KGRIB_HANDLE,'values',PDATA)
CALL IGRIB_GET_MESSAGE_SIZE(KGRIB_HANDLE,KGRIB_LEN)
ILENINT = (KGRIB_LEN+YIOS%NINTLEN-1)/YIOS%NINTLEN
IF(SIZE(KGRIB) < ILENINT) THEN
  WRITE(YIOS%NULERR,*) 'KGRIB TOO SMALL ',SIZE(KGRIB),ILENINT,KGRIB_LEN
  CALL ABOR1('GRIB_CODE_MESSAGE:KGRIB TOO SMALL ')
ENDIF
CALL IGRIB_GET_MESSAGE(KGRIB_HANDLE,KGRIB)
IF (LHOOK) CALL DR_HOOK('IOSTREAM_MIX:GRIB_UPDATE_MESSAGE',1,ZHOOK_HANDLE)
END SUBROUTINE GRIB_UPDATE_MESSAGE
 !=============================================================
END MODULE IOSTREAM_MIX
