SUBROUTINE SC2RDG (YD_PGPBUF,KJUMP,KSTA,KEND,PGP,KFSTA,KFEND,KPROMA)

!**** *SC2RDG* - Read in gridpoint array from work file

!     Purpose.  Read in gridpoint array from
!     --------  workfile or alternativly copy from grid-point buffer.

!**   Interface.
!     ----------
!        *CALL* *SC2RDG(...)

!        --------------------  PGPBUF  - grid-point buffer
!                              KJUMP   - points to first column
!                                        processed by this call
!                              KSTA    - starting point in pct
!                              KEND    - end point in pct     
!                              PGP     - output array   
!                              KFSTA   - starting field (optional)
!                              KFEND   - ending field (optional)

!        Implicit arguments :  None
!        --------------------

!     Method.
!     -------

!     Externals. MIOREAD - read routine from MIO package
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS
!        MIO documentation

!     Author.
!     -------
!        Mats Hamrud  *ECMWF*

!     Modifications.
!     --------------
!        Original : 92-08-01
!        M Fisher : 99-11-10  -  introduced the gridpoint_buffer type
!        G Mozdzynski : 02-03-19 - support KFSTA, KFEND
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMDIM   , ONLY : NPROMA
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULERR
USE GRIDPOINT_BUFFERS_MIX , ONLY : GRIDPOINT_BUFFER

IMPLICIT NONE

TYPE(GRIDPOINT_BUFFER),INTENT(IN)    :: YD_PGPBUF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KJUMP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGP(NPROMA,YD_PGPBUF%IFIELDS) 
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)    :: KFSTA 
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)    :: KFEND 
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)    :: KPROMA 
! === END OF INTERFACE BLOCK ===

INTEGER(KIND=JPIM) :: IBLOCKS, IJUMP, IPCKUNIT, ISTA, IWORDS, JF, J,&
 & ISTAGPB,II,I1,I2,IPROMA
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "emptb.intfb.h"

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

!*       1.    READ IN GRIDPOINT ARRAY.
!              ------------------------

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

IF(PRESENT(KPROMA))THEN
  IPROMA=KPROMA
ELSE
  IPROMA=NPROMA
ENDIF
IF( .NOT. ASSOCIATED (YD_PGPBUF%GPBUF)) THEN
  WRITE(NULERR,*)'SC2RDG:GRID-POINT BUFFER NOT ALLOCATED ',YD_PGPBUF%CLNAME
  CALL ABOR1('SC2RDG:GRID-POINT BUFFER NOT ALLOCATED')
ENDIF
IF( .NOT.YD_PGPBUF%LFILLED) THEN
  WRITE(NULERR,*)'SC2RDG:GRID-POINT BUFFER NOT FILLED ',YD_PGPBUF%CLNAME
  CALL ABOR1('SC2RDG:GRID-POINT BUFFER NOT FILLED')
ENDIF
ISTAGPB = 0
IWORDS = KEND-KSTA+1

!*       1.3       COPY FROM GRIDPOINT BUFFER

IJUMP=KJUMP-1
IF (YD_PGPBUF%IPACK == 1) THEN
  ISTA=ISTAGPB+1+IJUMP*YD_PGPBUF%IFIELDS
ELSE

!  It is assumed that GT9BUF data always is read/written in
!  NPROMA chunks (except for the last potentially smaller chunk).
!  Restrictions are necessary because reading/writing of packed
!  data has to start on a word boundary.

  IBLOCKS=IJUMP/IPROMA
  IF (IBLOCKS*IPROMA /= IJUMP)&
   & CALL ABOR1('SC2RDG: INCONSISTENT WRITING OF PACKED DATA')  
  IPCKUNIT = (IPROMA+YD_PGPBUF%IPACK-1)/YD_PGPBUF%IPACK
  ISTA = ISTAGPB+1+IPCKUNIT*IBLOCKS*YD_PGPBUF%IFIELDS
ENDIF

IF(YD_PGPBUF%IPACK == 1) THEN
  IF( PRESENT(KFSTA).AND.PRESENT(KFEND) )THEN
    I1=KFSTA
    I2=KFEND
  ELSE
    I1=1
    I2=YD_PGPBUF%IFIELDS
  ENDIF
  II = ISTA
  DO JF=I1,I2
    II=ISTAGPB+1+IJUMP*YD_PGPBUF%IFIELDS+(JF-1)*IWORDS
    DO J=1,IWORDS
      PGP(KSTA+J-1,JF) = YD_PGPBUF%GPBUF(II)
      II = II+1
    ENDDO
  ENDDO
  ISTA = II
ELSE
  DO JF=1,YD_PGPBUF%IFIELDS
    CALL EMPTB(IWORDS,PGP(KSTA,JF),YD_PGPBUF%GPBUF,YD_PGPBUF%IBLEN,ISTA, &
     & YD_PGPBUF%IPACK,6)  
  ENDDO
ENDIF

IF(ISTA > YD_PGPBUF%IBLEN+1) then
  WRITE(NULERR,*)YD_PGPBUF%CLNAME, ISTA,YD_PGPBUF%IBLEN
  CALL ABOR1('SC2RDG:GRID-POINT BUFFER TOO SMALL')
ENDIF
  
!     ------------------------------------------------------------------

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