SUBROUTINE EXTGPF (KFIELDS,YD_PGPBUF,KFLDPTP,KSTAF,PREALG,KNFL,KDIMG,KNFD,&
 & KFLDOFF,LDCOM)  

!**** *EXTGPF*  - extracts 2-D fields from gridpoint file

!     Purpose.
!     --------
!     Write out the model level fileds of the model
!     gridpoint buffer. Performs a transpose from ordering by the
!     NPROMA based packets used in the gridpoint calculations
!     to an ordering by fields. The result is in the form of an
!     array PREALG dimensioned PREALG(KDIMG,KNFL) containing
!     the extracted fields stored from the north pole to the south
!     (poles excluded) stored in a compact way taking into
!     account the reduced grid. The result is suitable for being
!     fed directly to the output routines (FAIENC) or grib packing
!     routines (GRIBEX)

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

!        Explicit arguments :
!        --------------------

!        KFIELDS   - number of fields to be extracted from wrk file
!        PGPBUF    - memory buffer ( used in case of no real IO)
!        KFLDPTP   - array of field pointers for extraction
!        KSTAF     - first field to be extracted
!        PREALG    - extracted fields (output)
!        KNFL      - (local) number of global field treated by my proc.
!        KDIMG     - first dimension of output array PREALG
!        KNFD      - number of fields for each processor
!        KFLDOFF   - offset before the first global field belonging to my proc.
!        LDCOM     - .TRUE. if communications included

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

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

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

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

!     Modifications.
!     --------------
!        Original : 92-10-01
!        M.Hamrud : 95-10-15 Interface block
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!         -> polar values are not computed and stored any longer, only
!            non polar values are stored in the elements 1 to NGPTOTG of PREALG.
!        R. El Khatib : 99-12-28 remove poles rows
!        R. El Khatib : 00-11-02 Optional communications included so the output 
!         array can really be a global output array 
!        R. El Khatib : 01-01-17 Remove SM aspect
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        K. Yessad    : 31-01-2007 Cleanings + adapt call to DIWRGRFP.
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NPROMA
USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTMX
USE GRIDPOINT_BUFFERS_MIX , ONLY : GRIDPOINT_BUFFER
USE YOMFPGIND, ONLY : NFPRGPNUM, NFPRGPIND
USE YOMCT0   , ONLY : NPROC
USE YOMTAG   , ONLY : MTAGDISTGP

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

IMPLICIT NONE

TYPE(GRIDPOINT_BUFFER),INTENT(IN)    :: YD_PGPBUF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNFL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIMG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELDS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDPTP(YD_PGPBUF%IFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTAF 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PREALG(KDIMG,KNFL) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNFD(NPROC) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDOFF(NPROC) 
LOGICAL           ,INTENT(IN)    :: LDCOM 

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

REAL(KIND=JPRB) :: ZGPP(NPROMA,YD_PGPBUF%IFIELDS)
REAL(KIND=JPRB) :: ZREALL(NGPTOT,KFIELDS)

INTEGER(KIND=JPIM) :: IEND, IST, JF, JKGLO, JROF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "diwrgrfp.intfb.h"
#include "sc2rdg.intfb.h"

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

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

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

!*       1.     COPY FROM NPROMA FORMAT TO FIELD FORMAT 
!               ----------------------------------------

IST=1
DO JKGLO=1,NGPTOT,NPROMA
  IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
  CALL SC2RDG(YD_PGPBUF,JKGLO,IST,IEND,ZGPP)
  DO JF=1,KFIELDS
    DO JROF=IST,IEND
      ZREALL(JROF+JKGLO-1,JF)=ZGPP(JROF,KFLDPTP(JF+KSTAF-1))
    ENDDO
  ENDDO
ENDDO

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

!*       2.     DISTRIBUTE FIELDS TO "I/O" PROCESSORS
!               -------------------------------------

IF (LDCOM) THEN

  ! (for post-processing only here, but it can easily be generalized)
  CALL DIWRGRFP(MTAGDISTGP,KFIELDS,KDIMG,NGPTOT,NGPTOTMX,KNFL, &
   & NFPRGPIND,NFPRGPNUM,KNFD,KFLDOFF,ZREALL,PREALG)

ELSE
 
  DO JF=1,KFIELDS
    PREALG(1:NGPTOT,JF)=ZREALL(1:NGPTOT,JF)
  ENDDO

ENDIF

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

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