SUBROUTINE SUGRIDG(KFILE,LDSPOR,PBLH,PFIELD)

!**** *SUGRIDG*  - Initialize the gridpoint fields from GRIB

!     Purpose.
!     --------
!           Initialize the gridpoint fields of the model from GRIB file.

!**   Interface.
!     ----------
!        *CALL* *SUGRIDG(....*

!        Explicit arguments : 
!        ------------------
!               KFILE   - indicator for which file is to be read
!                         KFILE = 0 the CFNIGG file is read
!                         KFILE = 1 the CFNGGG file is read
!                         KFILE = 2 the CFNRF  file is read
!                         KFILE = 5 the CFNPL file is read
!                         KFILE = 9 the CFNVAREPS file is read (for VAREPS)
!               LDSPOR  - switch indicating whether spectral orography
!                         field has been read
!               PBLH    - boundary-layer height (optional)
!        Implicit arguments :
!        --------------------

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

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

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

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

!     Modifications.
!     --------------
!        Original : 93-05-15  (from SUGRIDP and CPREP1)
!        R. El Khatib : 95-01-31 new option KFILE=5
!        Modified : 95-01-25 M.Hamrud (use PBGRIB instead of BUFFER IN)
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!         - removal of obsolete arguments in 'CALL MODGRIN'.
!    R. El Khatib : 99-12-28 remove poles rows
!        Modified : 99-03-26 J. Teixeira (Surface tiling)
!        Modified : 00-09-01 by D.Dent : MPE to MPL conversion
!        Modified : 00-10-26 M.Fisher : added optional argument PBLH
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning
!        R.Buizza :    20-May-2005 Introduce KFILE=9, to read VAREPS file with acc fields
!        M.Hamrud      01-Dec-2005 Generalized IO scheme
!        JJMorcrette   09-05-2006  Dust climatol.surf.fields
!        S. Serrar     05-06-23 CO2 surface fields GRIB identifiers defined
!        JJMorcrette   20060715 MODIS albedo
!        M.Hamrud      01-Jul-2006 Revised surface fields
!        H.Hersbach    04-Dec-2009 Read VDIAG in trajectory
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCT0   , ONLY : LFPART2, LIFSTRAJ
USE YOMDIM   , ONLY : NPROMA
USE YOMLUN   , ONLY : NULOUT
USE YOMGEM   , ONLY : NGPTOT  
USE YOMGRB   , ONLY : NGRBBLH,NGRBGRGSFC,JPGRG
USE YOMOP    , ONLY : CFNIGG   ,CFNPL    ,CFNGGG, CFNVAREPS
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_GET, &
 & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, CLOSE_IOREQUEST
USE YOMVAREPS, ONLY : LVAREPS, NAFVAREPS, NAFVAREPSGC
USE SURFACE_FIELDS_MIX, ONLY : GPOPER,TYPE_SFL_COMM,NSURFL,&
 & SP_SB, YSP_SBD, YSP_SB, SP_SG, YSP_SGD, YSP_SG, &
 & SP_RR, YSP_RRD, YSP_RR, SD_WS, YSD_WSD, YSD_WS, &
 & SD_WW, YSD_WWD, YSD_WW, &
 & SD_VF, YSD_VFD, YSD_VF, SD_VP, YSD_VPD, YSD_VP, &
 & SD_VD, YSD_VDD, YSD_VD

IMPLICIT NONE

!     EXTERNAL INTEGER FUNCTIONS
INTEGER(KIND=JPIM),INTENT(IN)    :: KFILE 
LOGICAL           ,INTENT(OUT)   :: LDSPOR 
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(INOUT) :: PBLH(:) 
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(INOUT) :: PFIELD(:,:) 
INTEGER(KIND=JPIM), EXTERNAL :: ISRCHEQ

REAL(KIND=JPRB), ALLOCATABLE :: ZFPDGG(:,:,:)

INTEGER(KIND=JPIM), ALLOCATABLE :: IGRIB2D(:)
CHARACTER (LEN = 16) ::  CLFN

INTEGER(KIND=JPIM) :: JC, I, IMAXFI, IGGMAX, IFIELDS
INTEGER(KIND=JPIM) :: JFLD, JROF, JV, IFLDP
INTEGER(KIND=JPIM) ::  JAF, ILEN, IFIELD, IND

INTEGER(KIND=JPIM) :: JSTGLO, IEND, JL, IBL
TYPE(TYPE_IOSTREAM) :: YL_IOSTREAM
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST
TYPE(TYPE_SFL_COMM) :: YLCOM
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "modgrin.intfb.h"

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

!*       1.    READ IN GRID-POINT FIELDS FROM GRIB DATA.
!              -----------------------------------------

IF (LHOOK) CALL DR_HOOK('SUGRIDG',0,ZHOOK_HANDLE)
IMAXFI=MAX(NAFVAREPS,NSURFL)+5

ALLOCATE (IGRIB2D(IMAXFI))

I=0

! Initialise igribio data structure
!   1 - grib code
!   2 - processor directed to perform grib input
!   3 - indicator to show field has been read

WRITE(NULOUT,'("SUGRIDG: KFILE=",I10)') KFILE
IF(LVAREPS.AND.(KFILE == 9)) THEN
  IF(.NOT.PRESENT(PFIELD)) CALL ABOR1('SUGRIDG-PFIELD MISSING')
  WRITE(NULOUT,'("SUGRIDG: LOOP JAF - NAFVAREPS=",I10)') NAFVAREPS
  DO JAF=1,NAFVAREPS
    I=I+1
    IGRIB2D(I)=NAFVAREPSGC(JAF)
  ENDDO
  IGGMAX=I
ELSE
  CALL GPOPER('GRIBIN',KBL=1,YDCOM=YLCOM)
  I = YLCOM%ICOUNT
  IGRIB2D(1:I) =YLCOM%ICODES(1:I) 
  IF( LFPART2 ) THEN
    LDSPOR=.TRUE.
    I=I+1
    IGRIB2D(I)=129
  ENDIF
  IF (PRESENT(PBLH)) THEN
    I=I+1
    IGRIB2D(I)=NGRBBLH
  ENDIF
ENDIF
IFIELDS=I
IF(IFIELDS > IMAXFI) THEN
  WRITE(NULOUT,*) ' IFIELDS GT IMAXFI '
  CALL ABOR1(' ERROR IN SUGRIDG')
ENDIF

WRITE(UNIT=NULOUT,FMT='(A)') ' READ SURFACE FIELDS FROM GRIB '
IF (KFILE == 0) THEN
  CLFN=CFNIGG
  WRITE(UNIT=NULOUT,FMT='(A,A)')' INITIAL DATA TO BE READ FROM FILE ',CLFN
ELSEIF (KFILE == 1) THEN
  CLFN=CFNGGG
  WRITE(UNIT=NULOUT,FMT='(A,A)')&
   & ' STARTING POINT FOR MINIMIZATION TO BE READ FROM FILE ',CLFN  
ELSEIF (KFILE == 5) THEN
  ILEN=INDEX(CFNPL,' ')-1
  CFNIGG='PH'//CFNPL(3:ILEN)
  CLFN=CFNIGG
  WRITE(UNIT=NULOUT,FMT='(A,A)')&
   & ' PRE-PROCESSED GRIDPOINT DATA TO BE READ FROM FILE ',CLFN  
ELSEIF (KFILE == 9) THEN
  ILEN=INDEX(CFNVAREPS,' ')-1
  CFNIGG=CFNVAREPS(1:ILEN)
  CLFN=CFNIGG
  WRITE(UNIT=NULOUT,FMT='(A,A)')&
   & ' VAREPS accumulated fields TO BE READ FROM FILE ',CLFN  
ELSE
  WRITE(*,'('' INVALID ARGUMENT TO SUGRIDG, KFILE='',I3)') KFILE
  CALL ABOR1(' INVALID ARGUMENT TO SUGRIDG')
ENDIF

ALLOCATE (ZFPDGG(NGPTOT,IFIELDS,1))

CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD)
DO JFLD=1,IFIELDS
  ZFPDGG(:,JFLD,1)=0.0_JPRB
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1409,1)

CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLFN),CDMODE='r',KIOMASTER=1)
CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB2D=IGRIB2D(1:IFIELDS),KPROMA=NGPTOT)
CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR3=ZFPDGG(:,1:IFIELDS,:))
CALL CLOSE_IOREQUEST(YL_IOREQUEST)
CALL CLOSE_IOSTREAM(YL_IOSTREAM)

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

!        2.    MODIFICATIONS TO FIELDS.
!              ------------------------

IF(LVAREPS.AND.(KFILE == 9)) THEN
  WRITE(NULOUT,'("SUGRIDG: KFILE=9 >> NO CALL MODGRIN - IFIELDS=",I10,1X)') IFIELDS
ELSE
  WRITE(NULOUT,'("SUGRIDG: CALL MODGRIN - IFIELDS=",I10)') IFIELDS
  CALL MODGRIN(IFIELDS,IGRIB2D,ZFPDGG(:,:,1))
ENDIF

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

!        3.    COPY PROGNOSTIC FIELDS.
!              -----------------------

IF(LVAREPS.AND.(KFILE == 9)) THEN

!*       3.0   Accumulated fields for VAREPS

  WRITE(NULOUT,'("SUGRIDG: KFILE=9 >> COPY PROGN FIELDS=")')
  DO JV=1,YSD_VDD%NUMFLDS
    IF(YSD_VD%YVD(JV)%IGRBCODE /= -999) THEN
      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSD_VD%YVD(JV)%IGRBCODE)
      WRITE(NULOUT,'("SUGRIDG: JV,IFLDP=",2(I10,1X))') JV,IFLDP
      IF(IFLDP <= IFIELDS) THEN
        CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JROF)
        DO JROF=1,NGPTOT
          PFIELD(JROF,JV) = ZFPDGG(JROF,IFLDP,1)
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1409,1)
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' READ FROM GRIB FILE INTO VDIAG - JV='',I2.2)') YSD_VD%YVD(JV)%IGRBCODE,JV
      ENDIF
    ENDIF
  ENDDO

ELSE


!*       3.2   SOILB

  DO JC=1,YSP_SBD%NLEVS
    DO JV=1,YSP_SBD%NUMFLDS
      IF(YSP_SB%YSB(JV)%IGRBCODE(JC) /= -999) THEN
        IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSP_SB%YSB(JV)%IGRBCODE(JC))
        IF(IFLDP <= IFIELDS) THEN
          CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTGLO,IEND,IBL,JL)
          DO JSTGLO=1,NGPTOT,NPROMA
            IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
            IBL=(JSTGLO-1)/NPROMA+1
            DO JL=1,IEND
              SP_SB(JL,JC,JV,IBL) =  ZFPDGG(JSTGLO+JL-1,IFLDP,1)
            ENDDO
          ENDDO
!$OMP END PARALLEL DO
          CALL GSTATS(1409,1)
          WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
           & '' READ FROM GRIB FILE INTO SOILB '',&
           & I2.2,1X,I2.2)')&
           & YSP_SB%YSB(JV)%IGRBCODE(JC),JC,JV
        ELSE
          WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
          WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
           & '' NOT FOUND BY SUGRIDG '')')YSP_SB%YSB(JV)%IGRBCODE(JC)
        ENDIF
      ENDIF
    ENDDO
  ENDDO

!*       3.5   SNOWG

  DO JV=1,YSP_SGD%NUMFLDS
    IF(YSP_SG%YSG(JV)%IGRBCODE /= -999) THEN
      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSP_SG%YSG(JV)%IGRBCODE)
      IF(IFLDP <= IFIELDS) THEN
        CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTGLO,IEND,IBL,JL)
        DO JSTGLO=1,NGPTOT,NPROMA
          IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
          IBL=(JSTGLO-1)/NPROMA+1
          DO JL=1,IEND
            SP_SG(JL,JV,IBL) = ZFPDGG(JSTGLO-1+JL,IFLDP,1)
          ENDDO
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1409,1)
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' READ FROM GRIB FILE INTO SNOWG '',&
         & I2.2)')&
         & YSP_SG%YSG(JV)%IGRBCODE,JV
      ELSE
        WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' NOT FOUND BY SUGRIDG '')')YSP_SG%YSG(JV)%IGRBCODE
      ENDIF
    ENDIF
  ENDDO
  IND=0

!*       3.6   RESVR

  DO JV=1,YSP_RRD%NUMFLDS
    IFIELD=IFIELD+1
    IF(YSP_RR%YRR(JV)%IGRBCODE /= -999) THEN
! get the interpolated surface temperature for Full_pos vertical int.
!      IF ( LFPART2.AND.(YSP_RR%YRR(JV)%IGRBCODE == NGRBSTL1).AND.(JV == NVRS) ) THEN
      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSP_RR%YRR(JV)%IGRBCODE)
      IF(IFLDP <= IFIELDS) THEN
        CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTGLO,IEND,IBL,JL)
        DO JSTGLO=1,NGPTOT,NPROMA
          IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
          IBL=(JSTGLO-1)/NPROMA+1
          DO JL=1,IEND
            SP_RR(JL,JV,IBL) = ZFPDGG(JSTGLO-1+JL,IFLDP,1)
          ENDDO
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1409,1)
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' READ FROM GRIB FILE INTO RESVR '',&
         & I2.2)')&
         & YSP_RR%YRR(JV)%IGRBCODE,JV
      ELSE
        WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' NOT FOUND BY SUGRIDG '')')YSP_RR%YRR(JV)%IGRBCODE  
      ENDIF
    ENDIF
  ENDDO

!*       3.7   WAVES

  DO JV=1,YSD_WSD%NUMFLDS
    IF(YSD_WS%YWS(JV)%IGRBCODE /= -999) THEN
      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSD_WS%YWS(JV)%IGRBCODE)
      IF(IFLDP <= IFIELDS) THEN
        CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTGLO,IEND,IBL,JL)
        DO JSTGLO=1,NGPTOT,NPROMA
          IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
          IBL=(JSTGLO-1)/NPROMA+1
          DO JL=1,IEND
            SD_WS(JL,JV,IBL) =  ZFPDGG(JSTGLO-1+JL,IFLDP,1)
          ENDDO
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1409,1)
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' READ FROM GRIB FILE INTO WAVES '',&
         & I2.2,1X,I2.2)')&
         & YSD_WS%YWS(JV)%IGRBCODE,JV
      ELSE
        WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' NOT FOUND BY SUGRIDG '')')YSD_WS%YWS(JV)%IGRBCODE
      ENDIF
    ENDIF
  ENDDO

  DO JV=1,YSD_WWD%NUMFLDS
    IF(YSD_WW%YWW(JV)%IGRBCODE /= -999) THEN
      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSD_WW%YWW(JV)%IGRBCODE)
      IF(IFLDP <= IFIELDS) THEN
        CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTGLO,IEND,IBL,JL)
        DO JSTGLO=1,NGPTOT,NPROMA
          IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
          IBL=(JSTGLO-1)/NPROMA+1
          DO JL=1,IEND
            SD_WW(JL,JV,IBL) =  ZFPDGG(JSTGLO-1+JL,IFLDP,1)
          ENDDO
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1409,1)
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' READ FROM GRIB FILE INTO WAVES '',&
         & I2.2,1X,I2.2)')&
         & YSD_WW%YWW(JV)%IGRBCODE,JV
      ELSE
        WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' NOT FOUND BY SUGRIDG '')')YSD_WW%YWW(JV)%IGRBCODE
      ENDIF
    ENDIF
  ENDDO


!*       3.8   EXTRP

!!$  DO JC=1,NCXP
!!$    DO JV=1,NVXP
!!$      IFIELD=IFIELD+1
!!$      IF(NEXTRPGB(JC,JV) /= -999) THEN
!!$        IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,NEXTRPGB(JC,JV))
!!$        IF(IFLDP <= IFIELDS) THEN
!!$          CALL GSTATS(1409,0)
!!$!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JROF)
!!$          DO JROF=1,NGPTOT
!!$            PFIELD(JROF,IFIELD) = ZFPDGG(JROF,IFLDP,1)
!!$          ENDDO
!!$!$OMP END PARALLEL DO
!!$          CALL GSTATS(1409,1)
!!$          WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
!!$           & '' READ FROM GRIB FILE INTO EXTRP '',&
!!$           & I2.2,1X,I2.2,1X,i6)')&
!!$           & NEXTRPGB(JC,JV),JC,JV,NFLDPTP(IFIELD)  
!!$        ELSE
!!$          WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
!!$          WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
!!$           & '' NOT FOUND BY SUGRIDG '')')NEXTRPGB(JC,JV)  
!!$        ENDIF
!!$      ENDIF
!!$    ENDDO
!!$  ENDDO
!!$
!!$!*       3.9   XTRP2
!!$
!!$  DO JV=1,NVXP2
!!$    IFIELD=IFIELD+1
!!$    IF(NXTRP2GB(JV) /= -999) THEN
!!$      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,NXTRP2GB(JV))
!!$      IF(IFLDP <= IFIELDS) THEN
!!$        CALL GSTATS(1409,0)
!!$!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JROF)
!!$        DO JROF=1,NGPTOT
!!$          PFIELD(JROF,IFIELD) = ZFPDGG(JROF,IFLDP,1)
!!$        ENDDO
!!$!$OMP END PARALLEL DO
!!$        CALL GSTATS(1409,1)
!!$        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
!!$         & '' READ FROM GRIB FILE INTO XTRP2 '',&
!!$         & I2.2,1X,i6)')&
!!$         & NXTRP2GB(JV),JV,NFLDPTP(IFIELD)  
!!$      ELSE
!!$        WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
!!$        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
!!$         & '' NOT FOUND BY SUGRIDG '')')NXTRP2GB(JV)  
!!$      ENDIF
!!$    ENDIF
!!$  ENDDO
!!$
!!$!     ------------------------------------------------------------------

! 4.0 VDIAG; only required in trajectory)

  IF(LIFSTRAJ) THEN
   DO JV=1,YSD_VDD%NUMFLDS
    IF(YSD_VD%YVD(JV)%IGRBCODE /= -999) THEN
      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSD_VD%YVD(JV)%IGRBCODE)
      IF(IFLDP <= IFIELDS) THEN
        CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTGLO,IEND,IBL,JL)
        DO JSTGLO=1,NGPTOT,NPROMA
          IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
          IBL=(JSTGLO-1)/NPROMA+1
          DO JL=1,IEND
            SD_VD(JL,JV,IBL) = ZFPDGG(JSTGLO-1+JL,IFLDP,1)
          ENDDO
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1409,1)
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' READ FROM GRIB FILE INTO VDIAG '',I2.2)')&
         & YSD_VD%YVD(JV)%IGRBCODE,JV
      ELSE
        IF(ANY(YSD_VD%YVD(JV)%IGRBCODE== NGRBGRGSFC(1:JPGRG))) THEN
          WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
          WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
           & '' NOT FOUND BY SUGRIDG SET TO ZERO '')')YSD_VD%YVD(JV)%IGRBCODE
          DO JSTGLO=1,NGPTOT,NPROMA
            IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
            IBL=(JSTGLO-1)/NPROMA+1
            DO JL=1,IEND
              SD_VD(JL,JV,IBL) = 0.0_JPRB
            ENDDO
          ENDDO
        ELSE
          WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
          WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
           & '' NOT FOUND BY SUGRIDG '')')YSD_VD%YVD(JV)%IGRBCODE
        ENDIF
      ENDIF
    ENDIF
   ENDDO
  ENDIF


! 4.1 VARSF

  DO JV=1,YSD_VFD%NUMFLDS
    IF(YSD_VF%YVF(JV)%IGRBCODE /= -999) THEN
      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSD_VF%YVF(JV)%IGRBCODE)
      IF(IFLDP <= IFIELDS) THEN
        CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTGLO,IEND,IBL,JL)
        DO JSTGLO=1,NGPTOT,NPROMA
          IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
          IBL=(JSTGLO-1)/NPROMA+1
          DO JL=1,IEND
            SD_VF(JL,JV,IBL) = ZFPDGG(JSTGLO-1+JL,IFLDP,1)
          ENDDO
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1409,1)
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' READ FROM GRIB FILE INTO VARSF '',I2.2)')&
         & YSD_VF%YVF(JV)%IGRBCODE,JV
      ELSE
        IF(ANY(YSD_VF%YVF(JV)%IGRBCODE== NGRBGRGSFC(1:JPGRG))) THEN
          WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
          WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
           & '' NOT FOUND BY SUGRIDG SET TO ZERO '')')YSD_VF%YVF(JV)%IGRBCODE
          DO JSTGLO=1,NGPTOT,NPROMA
            IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
            IBL=(JSTGLO-1)/NPROMA+1
            DO JL=1,IEND
              SD_VF(JL,JV,IBL) = 0.0_JPRB
            ENDDO
          ENDDO
        ELSE
          WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
          WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
           & '' NOT FOUND BY SUGRIDG '')')YSD_VF%YVF(JV)%IGRBCODE
        ENDIF
      ENDIF
    ENDIF
  ENDDO

!*       4.2   VCLIP

  DO JV=1,YSD_VPD%NUMFLDS
    IF(YSD_VP%YVP(JV)%IGRBCODE /= -999) THEN
      IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,YSD_VP%YVP(JV)%IGRBCODE)
      IF(IFLDP <= IFIELDS) THEN
        CALL GSTATS(1409,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JSTGLO,IEND,IBL,JL)
        DO JSTGLO=1,NGPTOT,NPROMA
          IEND = MIN(NPROMA,NGPTOT-JSTGLO+1)
          IBL=(JSTGLO-1)/NPROMA+1
          DO JL=1,IEND
            SD_VP(JL,JV,IBL) = ZFPDGG(JSTGLO-1+JL,IFLDP,1)
          ENDDO
        ENDDO
!$OMP END PARALLEL DO
         CALL GSTATS(1409,1)
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' READ FROM GRIB FILE INTO VCLIP '',&
         & I2.2)')&
         & YSD_VP%YVP(JV)%IGRBCODE,JV
      ELSE
        WRITE(NULOUT,'(2X,'' WARNING! WARNING! WARNING! '')')
        WRITE(NULOUT,'(2X,''GRIB CODE '',i6,&
         & '' NOT FOUND BY SUGRIDG '')')YSD_VP%YVP(JV)%IGRBCODE  
      ENDIF
    ENDIF
  ENDDO
ENDIF

IF(PRESENT(PBLH)) THEN
  IFLDP=ISRCHEQ(IFIELDS,IGRIB2D,1,NGRBBLH)
  IF(IFLDP <= IFIELDS) THEN
    PBLH(:) = ZFPDGG(:,IFLDP,1)
  ENDIF
ENDIF

DEALLOCATE (IGRIB2D)
DEALLOCATE (ZFPDGG)

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

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