SUBROUTINE READ_GRID_TRAJ(CDFILE,KTYPE3D,KTYPE2D,K3D,K2D,PGRID3,PGRID2,LDNEW,LDBACKGR,LDCLOSE)

!     Purpose.
!     --------
!     Read grid point fields and distribute them.

!     Arguments
!     ---------
!       CDFILE : Filename
!       KTYPE3D      : List of 3D field variable GRIB definitions
!       KTYPE2D      : List of 2D field variable GRIB definitions
!       K3D    : Number of 3D Grid point fields to read
!       K2D    : Number of 2D Grid point fields to read
!       PGRID3 : 3D Grid point fields to read
!       PGRID2 : 2D Grid point fields to read
!       LDNEW  : Open new file for reading (or read from file already open)

!     Author.
!     -------
!       L. Isaksen and Y. Tremolet

!     Modifications.
!     --------------
!       Original : 09-Jun-2004
! ----------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCT0, ONLY : NPROC
USE YOMDIM, ONLY : NPROMA, NGPBLKS, NFLEVG
USE PARDIM, ONLY : JPMXLE
USE YOMMP , ONLY : MYPROC
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_GET, &
 & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, &
 & CLOSE_IOREQUEST

IMPLICIT NONE

CHARACTER(LEN=*),      INTENT(IN)    :: CDFILE
INTEGER(KIND=JPIM),INTENT(IN)    :: K3D,K2D
INTEGER(KIND=JPIM),INTENT(IN)    :: KTYPE3D(K3D),KTYPE2D(K2D)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGRID3(NPROMA,NFLEVG,K3D,NGPBLKS)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGRID2(NPROMA,K2D,NGPBLKS)
LOGICAL, INTENT(IN) :: LDNEW
LOGICAL, INTENT(IN), OPTIONAL :: LDBACKGR
LOGICAL, INTENT(IN), OPTIONAL :: LDCLOSE

INTEGER(KIND=JPIM) :: IOPROC,JLEV,ILEV,JF,JBLK,IOFF
INTEGER(KIND=JPIM) :: IOPROCS(NPROC),ILEVLIST(NFLEVG)
INTEGER(KIND=JPIM) :: IGRIB2D(NFLEVG*K3D),ILEVS2D(NFLEVG*K3D),IPROC2D(NFLEVG*K3D)
INTEGER(KIND=JPIM) :: IONPROCS,ICHUNKS,JROC,JCH,ISTLEV,IENLEV,ILEVS
CHARACTER(LEN=128) :: CLFILELEV
CHARACTER(LEN=3) :: CLEV
CHARACTER(LEN=1) :: CLMODE
TYPE(TYPE_IOSTREAM), SAVE :: YL_IOSTREAM_BG(JPMXLE)
TYPE(TYPE_IOSTREAM), SAVE :: YL_IOSTREAM(JPMXLE)
TYPE(TYPE_IOSTREAM), SAVE :: YL_IOSTREAM_SL_BG, YL_IOSTREAM_SL
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST
REAL(KIND=JPRB),ALLOCATABLE :: ZGRID(:,:,:)
LOGICAL,SAVE :: LL_OPEN_STREAM(JPMXLE),LL_OPEN_STREAM_SL
LOGICAL,SAVE :: LLFIRST=.TRUE.
REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL :: LLBACKGR,LLCLOSE

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

IF (LHOOK) CALL DR_HOOK('READ_GRID_TRAJ',0,ZHOOK_HANDLE)

IF (PRESENT(LDBACKGR)) THEN
  LLBACKGR = LDBACKGR
ELSE
  LLBACKGR = .FALSE.
ENDIF
IF (PRESENT(LDCLOSE)) THEN
  LLCLOSE = LDCLOSE
ELSE
  LLCLOSE = .FALSE.
ENDIF
IF(LLFIRST) THEN
  LL_OPEN_STREAM(:) = .FALSE.
  LL_OPEN_STREAM_SL = .FALSE.
  LLFIRST = .FALSE.
ENDIF
CLMODE = 'r'
IOPROC = 1
IF (K3D > 0) THEN
  IONPROCS = MIN(NPROC,NFLEVG)
  ICHUNKS  = (NFLEVG-1)/IONPROCS+1
  DO JROC=1,IONPROCS
    IOPROCS(JROC) = JROC
  ENDDO
  DO JCH=1,ICHUNKS
    ISTLEV = (JCH-1)*IONPROCS+1
    IENLEV = MIN(NFLEVG,JCH*IONPROCS)
    ILEVS  = IENLEV-ISTLEV+1
    DO JLEV=ISTLEV,IENLEV

      IOPROC = JLEV-ISTLEV+1
      ILEVLIST(IOPROC) = JLEV

      IF (IOPROC == MYPROC) THEN
        WRITE(CLEV,'(I3.3)')JLEV
        CLFILELEV=CDFILE//'L'//CLEV
      ENDIF
    ENDDO
    IF(LDNEW) THEN
      IF (LLBACKGR) THEN
        CALL SETUP_IOSTREAM(YL_IOSTREAM_BG(JCH),'CIO',TRIM(CLFILELEV),CDMODE=CLMODE,&
         & KIOPROCS=IOPROCS(1:ILEVS))
      ELSE
        IF(LL_OPEN_STREAM(JCH)) CALL CLOSE_IOSTREAM(YL_IOSTREAM(JCH)) 
        CALL SETUP_IOSTREAM(YL_IOSTREAM(JCH),'CIO',TRIM(CLFILELEV),CDMODE=CLMODE,&
         & KIOPROCS=IOPROCS(1:ILEVS))
        LL_OPEN_STREAM(JCH) = .TRUE.
      ENDIF
    ENDIF

    ALLOCATE(ZGRID(NPROMA,K3D*ILEVS,NGPBLKS))
    DO JF=1,K3D
      IOFF = (JF-1)*ILEVS
      IGRIB2D(IOFF+1:IOFF+ILEVS) = KTYPE3D(JF)
      ILEVS2D(IOFF+1:IOFF+ILEVS) = ILEVLIST(1:ILEVS)
      IPROC2D(IOFF+1:IOFF+ILEVS) = IOPROCS(1:ILEVS)
    ENDDO
    CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
     & KGRIB2D=IGRIB2D(1:K3D*ILEVS),KLEVS2D=ILEVS2D(1:K3D*ILEVS),KPROMA=NPROMA,&
     & LDRANDOM_ORDER=.FALSE.)
    IF (LLBACKGR) THEN
      CALL IO_GET(YL_IOSTREAM_BG(JCH),YL_IOREQUEST,&
       & PR3=ZGRID,KFLDPROC2D=IPROC2D(1:K3D*ILEVS))
    ELSE
      CALL IO_GET(YL_IOSTREAM(JCH),YL_IOREQUEST,&
       & PR3=ZGRID,KFLDPROC2D=IPROC2D(1:K3D*ILEVS))
    ENDIF
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JBLK,JF,IOFF)
    DO JBLK=1,NGPBLKS
      DO JF=1,K3D
        IOFF = (JF-1)*ILEVS
        PGRID3(:,ISTLEV:IENLEV,JF,JBLK) = ZGRID(:,IOFF+1:IOFF+ILEVS,JBLK)
      ENDDO
    ENDDO
!$OMP END PARALLEL DO
    CALL CLOSE_IOREQUEST(YL_IOREQUEST)
    DEALLOCATE(ZGRID)

    IF(LLCLOSE) THEN
      IF (LLBACKGR) THEN
        CALL CLOSE_IOSTREAM(YL_IOSTREAM_BG(JCH))
      ELSE
        CALL CLOSE_IOSTREAM(YL_IOSTREAM(JCH))
        LL_OPEN_STREAM(JCH) = .FALSE.
      ENDIF
    ENDIF
  ENDDO
ENDIF


! Processor 1 handles the surface fields

IF (K2D>0) THEN

  IOPROC = 1

  IF (K3D > 0) THEN
    ILEV = 0
    WRITE(CLEV,'(I3.3)')ILEV
    CLFILELEV = CDFILE//'L'//CLEV
  ELSE
    CLFILELEV=CDFILE
  ENDIF

  IF(LDNEW) THEN
    IF (LLBACKGR) THEN
      CALL SETUP_IOSTREAM(YL_IOSTREAM_SL_BG,'CIO',TRIM(CLFILELEV),CDMODE=CLMODE,&
       & KIOMASTER=IOPROC)
    ELSE
      IF(LL_OPEN_STREAM_SL) CALL CLOSE_IOSTREAM(YL_IOSTREAM_SL) 
      CALL SETUP_IOSTREAM(YL_IOSTREAM_SL,'CIO',TRIM(CLFILELEV),CDMODE=CLMODE,&
       & KIOMASTER=IOPROC)
        LL_OPEN_STREAM_SL = .TRUE.
    ENDIF
  ENDIF
  CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
   & KGRIB2D=KTYPE2D(1:K2D),KPROMA=NPROMA,LDRANDOM_ORDER=.FALSE.)
  IF (LLBACKGR) THEN
    CALL IO_GET(YL_IOSTREAM_SL_BG,YL_IOREQUEST,&
     & PR3=PGRID2)
  ELSE
    CALL IO_GET(YL_IOSTREAM_SL,YL_IOREQUEST,&
     & PR3=PGRID2)
  ENDIF
  CALL CLOSE_IOREQUEST(YL_IOREQUEST)
  IF(LLCLOSE) THEN
    IF (LLBACKGR) THEN
      CALL CLOSE_IOSTREAM(YL_IOSTREAM_SL_BG)
    ELSE
      CALL CLOSE_IOSTREAM(YL_IOSTREAM_SL)
      LL_OPEN_STREAM_SL = .FALSE.
    ENDIF
  ENDIF
ENDIF

IF (LHOOK) CALL DR_HOOK('READ_GRID_TRAJ',1,ZHOOK_HANDLE)
END SUBROUTINE READ_GRID_TRAJ
