SUBROUTINE INIFGER

!***  *INIFGER* - READ AND DECODE FORECAST ERROR

!     PURPOSE.
!     --------

!        READ, DECODE FORECAST ERROR 
!        THE FIRST-GUESS FORECAST ERROR FILE HAS BEEN
!        ARCHIVED BY MARS IN GRIB FORMAT. THE FILE IS READ AND DECODED
!        FOR USE WITHIN THE IFS. BOTH THE OLD OI ERROR FILES AS WELL AS
!        THE NEW CONJUGATE GRADIENT ERRORS CAN BE USED AS INPUT.

!**   INTERFACE .
!     ----------
!        *CALL* *INIFGER*

!        EXPLICIT ARGUMENTS:
!        -------------------

!        IMPLICIT ARGUMENTS:
!        -------------------

!     METHOD.
!     -------
!        FORECAST ERRORS FOR THE CURRENT ANALYSIS ARE ARCHIVED IN MARS.
!        THESE FIELDS  ARE READ IN AND DISTRIBUTED.
!        IF THERE ARE NO ERRORS FOR CERTAIN VARIABLES (CURRENTLY IN OI
!        THERE IS NO ERROR FOR PS NOR Q), THEY ARE SPECIFIED.

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------

!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS.

!     AUTHOR.
!     -------

!     M Hamrud          ECMWF   25/1/01 Fom GEFGER

!     MODIFICATIONS.
!     --------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        M.Hamrud      01-Dec-2005 Generalized IO scheme

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMMP    , ONLY : MYPROC
USE YOMCT0   , ONLY : NPROC
USE YOMLUN   , ONLY : NULOUT
USE YOMCST   , ONLY : RPI
USE YOMSCC   , ONLY : LSCDPR
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_GET, &
 & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, IO_INQUIRE, &
 & CLOSE_IOREQUEST
USE YOMFGER  , ONLY : MNROWS  ,MNVARS  ,MNFLDS  ,&
 & MNPTE   ,MNLEVMX  ,MLONE   ,MFIELDS ,MNLEVS  ,&
 & RZLATE  ,RZLON0E  ,RZDLONE ,RZA     ,RZB     ,RZEGRID,&
 & JPMAXLEV,JPMAXVAR
USE MPL_MODULE  , ONLY : MPL_BROADCAST

IMPLICIT NONE

CHARACTER(LEN=7) :: CLFILE='errgrib'
INTEGER(KIND=JPIM) :: ITAG,JVAR,II,JLEV
INTEGER(KIND=JPIM) :: ILEVS(JPMAXLEV,JPMAXVAR)
INTEGER(KIND=JPIM) :: IGRIB2D(JPMAXLEV*JPMAXVAR),ILEVS2D(JPMAXLEV*JPMAXVAR)
REAL(KIND=JPRB), ALLOCATABLE :: ZEGRID(:,:,:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
TYPE(TYPE_IOSTREAM) :: YL_IOSTREAM
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST

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

!        1.    GET THE FORECAST ERRORS

!           1.1   DETERMINE THE FORECAST ERROR GRID PARAMETERS

IF (LHOOK) CALL DR_HOOK('INIFGER',0,ZHOOK_HANDLE)
MLONE(:) = 0
MFIELDS(:) = 0
MNLEVS(:) = 0

CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLFILE),CDMODE='r',KIOMASTER=1)
CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.)
CALL IO_INQUIRE(YL_IOSTREAM,YL_IOREQUEST,&
 & KLATS=MNROWS,KLONS=MLONE,PLATS=RZLATE,&
 & KNVARS=MNVARS,KPARAMS=MFIELDS,KNLEVS=MNLEVS,&
 & PA=RZA,PB=RZB,KLEVS=ILEVS)
CALL CLOSE_IOREQUEST(YL_IOREQUEST)
CALL CLOSE_IOSTREAM(YL_IOSTREAM)
RZLON0E(:) = 0.0_JPRB


RZDLONE(1:MNROWS) = 2.0_JPRB * RPI / MLONE(1:MNROWS)

!           1.3   ALLOCATE ARRAY AND READ THE FORECAST ERRORS

MNPTE  = SUM(MLONE(1:MNROWS))
MNFLDS = SUM(MNLEVS(1:MNVARS))
MNLEVMX=MAXVAL(MNLEVS(1:MNVARS))

ALLOCATE (RZEGRID(MNPTE,MNFLDS))
IF(LSCDPR) THEN
  WRITE(NULOUT,9990) 'RZEGRID   ',SIZE(RZEGRID   ),SHAPE(RZEGRID   )
ENDIF

II = 0
DO JVAR=1,MNVARS
  DO JLEV=1,MNLEVS(JVAR)
    II = II+1
    IGRIB2D(II)  = MFIELDS(JVAR)
    ILEVS2D (II) = ILEVS(JLEV,JVAR)
  ENDDO
ENDDO

ALLOCATE (ZEGRID(MNPTE,MNFLDS,1))
CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLFILE),CDMODE='r',KIOMASTER=1)
CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB2D=IGRIB2D(1:MNFLDS),KLEVS2D=ILEVS2D(1:MNFLDS),&
 & KPROMA=MNPTE,LDISTRIBUTE=.FALSE.)
CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR3=ZEGRID)
CALL CLOSE_IOREQUEST(YL_IOREQUEST)
CALL CLOSE_IOSTREAM(YL_IOSTREAM)
IF(MYPROC == 1) RZEGRID(:,:) = ZEGRID(:,:,1)
DEALLOCATE (ZEGRID)

!           1.4   COMMUNICATE ERROR FIELDS

IF(NPROC >1) THEN
  ITAG = 1100
  CALL MPL_BROADCAST(RZEGRID(1:MNPTE,1:MNFLDS), KTAG=ITAG, KROOT=1, &
   & CDSTRING='INIFGER')  
ENDIF
IF (LHOOK) CALL DR_HOOK('INIFGER',1,ZHOOK_HANDLE)

9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
9991 FORMAT(1X,'ARRAY ',A10,' DEALLOCATED ')

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

END SUBROUTINE INIFGER
