SUBROUTINE SUSPECG(PSPA3,PSPA2,CDPATH,KFILE,LDINOR,LDSPOR)

!**** *SUSPECG*  - Initialize the spectral fields from GRIB.

!     Purpose.
!     --------
!           Initialize the spectral fields of the model from GRIB file(s)

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

!        Explicit arguments :
!        --------------------
!        KFILE : an indicator for which spectral file is to be read
!               KFILE = 0 the CFNISH file is read
!               KFILE = 1 the CFNGSH file is read
!               KFILE = 2 the CFNRF file is read
!               KFILE = 5 the CFNPL file is read
!               KFILE = 6 the CFNFGI file is read
!               KFILE = 7 the CFNANI file is read
!               KFILE =12 the CFNBGHRSH file is read
!               PSPVOR etc. - spectral fields
!               LDINOR - switch for initializing the orography
!               LDSPOR - switch indicating whether spectral orography
!                        field has been read

!        Implicit arguments :
!        --------------------
!        The spectral fields of the model.
!        The boundary condition fields of the model.

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

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

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

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

!     Modifications.
!     --------------
!        Original : 93-05-15 (From SUSPEC 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 : 95-06-06 L.Isaksen (Reordering of spectral arrays)
!        Modified 95-10-01 by M.Hamrud (F90 style passing of args.)
!        Modified : 95-12-22 M.Hamrud    Change of ZREEL layout
!        J.N Thepaut : 96-01-31 new option KFILE=6,7
!        M. Fisher : 97-05-01 Set PSPSV to zero
!        Modified 97-11-28 by E.Holm (Ozone included)
!        M. Hamrud : 98-05-20 Distribute GRIB decoding
!        M.Hamrud  : 98-08-10 Internal int. from low to high resolution
!        E.Holm    : 98-11-06 Ozone included in internal interpolation
!        D.Dent    : 00-09-01  MPE to MPL conversion
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2005 Generalized IO scheme
!        J.Haseler     27-Feb-2007 LTRAJIO controls writes to trajectory
!        E.Holm        13-Nov-2008 Add high resolution background=12, used
!                                  by rdfpinc for adding increments
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMDIM   , ONLY : NFLEVL   ,NSPEC2   , NFLEVG ,&
 & NS3D     ,NS2D     , NFTHER
USE YOMOP    , ONLY : CFNISH   ,CFNPL    ,CFNRF    ,CFNGSH   ,&
 & CFNFGI   ,CFNANI   ,CFNBGHRSH
USE YOMGRB   , ONLY : NGRBZ    ,NGRBLNSP ,NGRBSP3  
USE YOMVFP   , ONLY : LSPINT
USE YOM_YGFL , ONLY : YGFL, YGFLC
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_GET, &
 & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, CLOSE_IOREQUEST
USE TRAJECTORY_MOD, ONLY: LTRAJHR

IMPLICIT NONE

REAL(KIND=JPRB),TARGET     ,INTENT(OUT)   :: PSPA3(:,:,:) 
REAL(KIND=JPRB)            ,INTENT(OUT)   :: PSPA2(:,:)
CHARACTER(LEN=*)  ,OPTIONAL,INTENT(IN)    :: CDPATH
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)    :: KFILE 
LOGICAL           ,OPTIONAL,INTENT(IN)    :: LDINOR 
LOGICAL           ,OPTIONAL,INTENT(INOUT) :: LDSPOR 

CHARACTER (LEN = 16) ::  CLFN

INTEGER(KIND=JPIM) :: IGRIB2D(NS2D),IGRIB3D(NS3D+YGFL%NUMFLDS)
INTEGER(KIND=JPIM) :: IFILE,I2D,JGFL,JK,I3D,ISPTOGP
LOGICAL :: LLINOR, LLSPINT, LLINCR
LOGICAL :: LLMISSING_3D(NFLEVG,NS3D+YGFL%NUMFLDS)
TYPE(TYPE_IOSTREAM) :: YL_IOSTREAM
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB),POINTER :: ZSPA3(:,:,:)

#include "abor1.intfb.h"
#include "suspgpg.intfb.h"

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

!*       1.    INITIALIZE SPECTRAL FIELDS FROM GRIB FILE.
!              ------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUSPECG',0,ZHOOK_HANDLE)
CALL GSTATS(18,0)

IF(PRESENT(LDINOR)) THEN
  LLINOR = LDINOR
ELSE
  LLINOR = .FALSE.
ENDIF
  
IF(PRESENT(KFILE)) THEN
  IF(PRESENT(CDPATH)) CALL ABOR1('SUSPECG:BOTH KFILE AND CDPATH PRESENT')
  IFILE = KFILE
ELSE
  IF(PRESENT(CDPATH)) THEN
    CLFN = CDPATH
    IFILE = -99
  ELSE
    CALL ABOR1('SUSPECG:NEITHER KFILE OR CDPATH PRESENT')
  ENDIF
ENDIF

! For minimization task the ICMSH..IMIN is not needed when interpolated trajectory
! is used (i.e. when LTRAJHR=.true.)

IF(IFILE /= 1 .OR. (IFILE == 1 .AND. .NOT.LTRAJHR)) THEN

  LLINCR  = (IFILE == 6.OR.IFILE == 7) ! Lower resolution spectral input
  LLSPINT = LSPINT.AND.LLINCR          ! Gridpoint fields from L.R. spec. input
  
  WRITE(UNIT=NULOUT,FMT='(A)')  ' READ SPECTRAL DATA FROM GRIB '
  IF(LLINCR) WRITE(NULOUT,'(A)')' INPUT DATA AT DIFFERENT RESOLUTION'
  
  IF (IFILE == 0) THEN
    CLFN=CFNISH
    WRITE(UNIT=NULOUT,FMT='(A,A)')' INITIAL DATA TO BE READ FROM FILE ',CLFN
  ELSEIF (IFILE == 1) THEN
    CLFN=CFNGSH
    IF(.NOT.LTRAJHR) THEN
      WRITE(UNIT=NULOUT,FMT='(A,A)')&
       & ' STARTING POINT FOR MINIMIZATION TO BE READ FROM FILE ',CLFN  
    ENDIF
  ELSEIF (IFILE == 2) THEN
    CLFN=CFNRF
    WRITE(UNIT=NULOUT,FMT='(A,A)')' REFERENCE DATA TO BE READ FROM FILE ',CLFN
  ELSEIF (IFILE == 5) THEN
    CLFN=CFNPL
    WRITE(UNIT=NULOUT,FMT='(A,A)')&
     & ' PRE-PROCESSED SPECTRAL DATA TO BE READ FROM FILE ',CLFN  
  ELSEIF (IFILE == 6) THEN
    CLFN=CFNFGI
    WRITE(UNIT=NULOUT,FMT='(A,A)')&
     & ' LOW RESOLUTION FG TO BE READ FROM FILE ',CLFN  
  ELSEIF (IFILE == 7) THEN
    CLFN=CFNANI
    WRITE(UNIT=NULOUT,FMT='(A,A)')&
     & ' LOW RESOLUTION AN TO BE READ FROM FILE ',CLFN  
  ELSEIF (IFILE == 12) THEN
    CLFN=CFNBGHRSH
    WRITE(UNIT=NULOUT,FMT='(A,A)')&
     & ' HIGH RES SH BG TO BE READ FROM FILE ',CLFN  
  ELSEIF (IFILE == -99) THEN
    WRITE(UNIT=NULOUT,FMT='(A,A)')&
     & ' DATA TO BE READ FROM FILE ',CLFN  
  ELSE
    WRITE(NULERR,'('' INVALID ARGUMENT TO SUSPECG, KFILE='',I3)')KFILE
    CALL ABOR1(' INVALID ARGUMENT TO SUSPECG ')
  ENDIF

  !   2d variables
  
  I2D = 0
  
  !     surface pressure
  
  I2D = I2D+1
  IGRIB2D(I2D) = NGRBLNSP
  
  !     orography
  IF(PRESENT(LDSPOR)) LDSPOR = .FALSE.
  IF( LLINOR )THEN
    IF(PRESENT(LDSPOR))  LDSPOR = .TRUE.
    I2D = I2D+1
    IGRIB2D(I2D) = NGRBZ
  ENDIF
  
  !   3d variables
  
  ! GMV 
  I3D = 2+NFTHER
  IGRIB3D(1:I3D) = NGRBSP3(1:I3D)
  !GFL
  DO JGFL=1,YGFL%NUMFLDS
    IF(YGFLC(JGFL)%LSP) THEN
      IF(YGFLC(JGFL)%NREQIN == 1) THEN
        IGRIB3D(I3D+YGFLC(JGFL)%MPSP) = YGFLC(JGFL)%IGRBCODE
      ELSE
        IGRIB3D(I3D+YGFLC(JGFL)%MPSP) = -99
      ENDIF
    ENDIF
  ENDDO
  I3D = I3D+YGFL%NUMSPFLDS
  !GFL gridpoint fields possibly initialized from spectral
  ISPTOGP=0
  DO JGFL=1,YGFL%NUMFLDS
    IF(YGFLC(JGFL)%LGP) THEN
      IF(YGFLC(JGFL)%NREQIN == 1) THEN
        IF(.NOT.YGFLC(JGFL)%LGPINGP .AND. .NOT.YGFLC(JGFL)%LTRAJIO .OR. LLSPINT) THEN
          ISPTOGP=ISPTOGP+1
          IGRIB3D(I3D+ISPTOGP) = YGFLC(JGFL)%IGRBCODE
          WRITE(NULOUT,*) 'SUSPECG: GRIDPOINT FIELDS INITIALIZED FROM SPECTRAL', YGFLC(JGFL)%IGRBCODE
        ENDIF
      ENDIF
    ENDIF
  ENDDO

  WRITE(UNIT=NULOUT,FMT='('' I3D = '',I5,'', ISPTOGP = '',I5)') I3D,ISPTOGP
  WRITE(UNIT=NULOUT,FMT='('' SUSPECG:: IGRIB3D'')')
  WRITE(UNIT=NULOUT,FMT='(1X,5I10)') (IGRIB3D(JK),JK=1,I3D+ISPTOGP)
  
  IF(ISPTOGP == 0) THEN
    ZSPA3 => PSPA3
  ELSE
    ALLOCATE(ZSPA3(NFLEVL,NSPEC2,I3D+ISPTOGP))
  ENDIF
  CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLFN),CDMODE='r',KIOMASTER=1)
  CALL SETUP_IOREQUEST(YL_IOREQUEST,'SPECTRAL_FIELDS',LDGRIB=.TRUE.,&
   & KGRIB3D=IGRIB3D(1:I3D+ISPTOGP),KGRIB2D=IGRIB2D(1:I2D),&
   & LDINTERP=LLINCR)
  CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR2=PSPA2(:,1:I2D),PR3=ZSPA3,LDMISSING_3D=LLMISSING_3D)
  CALL CLOSE_IOREQUEST(YL_IOREQUEST)
  CALL CLOSE_IOSTREAM(YL_IOSTREAM)
  
  DO JGFL=1,I3D+ISPTOGP
    DO JK=1,NFLEVG
      IF( IGRIB3D(JGFL) > 0 .AND. LLMISSING_3D(JK,JGFL) ) THEN
        WRITE(NULERR,*) ' MISSING GRIBCODE=',IGRIB3D(JGFL),' LEVEL=',JK
!        CALL ABOR1('SUSPECG:MISSING INPUT FIELD')
      ENDIF
    ENDDO
  ENDDO
  
  IF(ISPTOGP > 0) THEN
    PSPA3(:,:,:) = ZSPA3(:,:,1:I3D)
    ISPTOGP = 0
    DO JGFL=1,YGFL%NUMFLDS
      IF(YGFLC(JGFL)%LGP) THEN
        IF(YGFLC(JGFL)%NREQIN == 1) THEN
          IF(.NOT.YGFLC(JGFL)%LGPINGP .OR. LLSPINT) THEN
            ISPTOGP=ISPTOGP+1
            CALL SUSPGPG(ZSPA3(:,:,I3D+ISPTOGP),YGFLC(JGFL)%IGRBCODE)
            WRITE(NULOUT,FMT='('' SUSPGPG for '',I5)') YGFLC(JGFL)%IGRBCODE
          ENDIF
        ENDIF
      ENDIF
    ENDDO
    DEALLOCATE(ZSPA3)
  ELSE
    NULLIFY(ZSPA3)
  ENDIF

ENDIF

CALL GSTATS(18,1)

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