SUBROUTINE RDECCLIMO(PFIELD,KGP,KFIELDS,KCOD,KLI,LDMASK)

!**** *RDCLIMO*  - READ OUTPUT CLIMATOLOGY

!     PURPOSE.
!     --------
!        Open output climatology files and read the needed fields

!**   INTERFACE.
!     ----------
!       *CALL* *RDECCLIMO*

!        EXPLICIT ARGUMENTS
!        --------------------
!        PFIELD : OUTPUT FIELDS ARRAY
!        KGP    : NUMBER OF OUTPUT POINTS
!        KFIELDS: NUMBER OF OUTPUT FIELDS
!        KCOD   : FIELDS CODES
!        KLI    : CLIMATOLOGY OPTION (1 => constant values ;
!                                     2 or 3 => monthly values)
!        LDMASK : logical mask in order to skip fields.

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

!     METHOD.
!     -------
!        SEE DOCUMENTATION

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

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS
!        Documentation about FULL-POS.

!     AUTHOR.
!     -------
!           Nils Wedi

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 95-12-15
!        Modified by K. YESSAD (MARCH 1997): parallelisation of FULL-POS.
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!    R. El Khatib : 98-10-16 : LDMASK (for DM efficiency)
!    R. El Khatib : 03-04-17 Fullpos improvemnts
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!    R. El Khatib : 05-03-15 Cleanings
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMLUN   , ONLY : NULOUT
USE YOMMSC   , ONLY : NINTLEN
USE PARFPOS  , ONLY : JPOSDOM  ,JPOSLEN
USE PARDIM   , ONLY : JPMXLE   ,JPMXGL
USE YOMFPC   , ONLY : CFPDOM   ,NFPDOM
USE YOMFPD   , ONLY : NLAT     ,NLON     ,NFPSIZEG
USE YOMFPG   , ONLY : NFPRGRI  ,NFPHTYP
USE YOMCST   , ONLY : R
USE YOMRIP   , ONLY : NINDAT
USE YOMAFN   , ONLY : GFP_LSM  ,GFP_GFIS ,GFP_PHYDS

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KGP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELDS 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFIELD(KGP,KFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCOD(KFIELDS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLI 
LOGICAL           ,INTENT(IN)    :: LDMASK(KFIELDS) 
!     IPTR     : pointer of each subdomain in the general output array
!     ZREAL    : field read on a file ARPEGE.

CHARACTER(LEN=15+JPOSLEN) :: CLFPFN(2)
CHARACTER(LEN = 2)        ::  CLMONTH(2)
INTEGER(KIND=JPIM) :: IPTR(NFPDOM)
INTEGER(KIND=JPIM) :: IGRIG(NLON(1)*NLAT(1)),ILENG(JPOSDOM)
INTEGER(KIND=JPIM) :: ISEC0(2),ISEC1(125),ISEC2(22+JPMXGL),ISEC3(2),ISEC4(42)
REAL(KIND=JPRB) :: ZSEC2(10+2*(JPMXLE+1)),ZSEC3(2)
REAL(KIND=JPRB) :: ZREAL(KGP)

INTEGER(KIND=JPIM) :: IERR, IFLD, IJOUR, ILEN, ILENBYT, ILONG, IMM1, IMM2
INTEGER(KIND=JPIM) :: IPARAM, IRET, IUNITGG, IWORD, J, JD, JFLD, JGL, JJ  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include "fcttim.h"

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

!*       1. PREPARATIONS
!           ------------

IF (LHOOK) CALL DR_HOOK('RDECCLIMO',0,ZHOOK_HANDLE)
IPTR(1)=1
ILENG(1) = NLON(1)*NLAT(1)
DO JD=2,NFPDOM
  IPTR(JD)=IPTR(JD-1)+NFPSIZEG(JD-1)
  ILENG(JD) = NLON(JD)*NLAT(JD)
ENDDO

!*       2. LOOP ON SUBDOMAINS
!           ------------------

DO JD=1,NFPDOM

!*       2.1 OPEN FILE

  ILEN=INDEX(CFPDOM(JD)//' ',' ')-1
  IF (KLI <= 2) THEN
    CLFPFN(1)='const.clim.'//CFPDOM(JD)(1:ILEN)
  ELSEIF (KLI == 3) THEN
    IMM1=NMM(NINDAT)
    IJOUR=NDD(NINDAT)
    WRITE(CLMONTH(1),FMT='(I2.2)') IMM1
    IF (IJOUR <= 15) THEN
      IMM2=IMM1-1
    ELSE
      IMM2=IMM1+1
    ENDIF
    IF (IMM2 == 13) THEN
      IMM2=1
    ELSEIF (IMM2 == 0) THEN
      IMM2=12
    ENDIF
    WRITE(CLMONTH(2),FMT='(I2.2)') IMM2
    CLFPFN(1)='const.clim.'//CFPDOM(JD)(1:ILEN)//'.m'//CLMONTH(1)
    CLFPFN(2)='const.clim.'//CFPDOM(JD)(1:ILEN)//'.m'//CLMONTH(2)
    CALL ABOR1 ('RDECCLIMO : KLI=3 NOT FULLY IMPLEMENTED')
  ENDIF

  CALL PBOPEN(IUNITGG,CLFPFN(JD),'r',IRET)
  IF (IRET < 0) THEN
    WRITE(NULOUT,'(''ERROR OPENING FILE'',A16)') CLFPFN(JD)
    CALL ABOR1 ('RDECCLIMO')
  ELSE
    WRITE(NULOUT,*) 'READ FROM CLIMATE FILE ',CLFPFN(JD)
  ENDIF

!*       2.4 READ FIELDS

  ILENBYT=NLON(1)*NLAT(1)*NINTLEN

  FIELD_LOOP: DO JFLD=1,KFIELDS

    CALL PBGRIB(IUNITGG,IGRIG,ILENBYT,ILONG,IRET)
    IF(IRET == 0) THEN
      ILONG=ILONG/NINTLEN
    ELSEIF(IRET == -1) THEN
      EXIT FIELD_LOOP
    ELSE
      WRITE(NULOUT,'(A,I2)')'RDECCLIMO: PROBLEM IN PBGRIB, IRET=',IRET
      CALL ABOR1('RDECCLIMO: PROBLEM IN PBGRIB')
    ENDIF
    CALL GSTATS(1703,0)
    CALL GRIBEX(ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,&
     & ZREAL,ILENG,IGRIG,ILONG,IWORD,'D',IERR)  
    CALL GSTATS(1703,1)

    IPARAM=ISEC1(6)
    DO JJ=1,KFIELDS
      IF( GFP_PHYDS(KCOD(JJ))%IGRIB == IPARAM) IFLD=JJ
    ENDDO

    IF (LDMASK(IFLD)) THEN
      WRITE(NULOUT,*) 'PARAMETER ',IPARAM,' SKIPPED BY MYPROC'
      CYCLE
    ELSEIF (IPARAM /= GFP_LSM%IGRIB .AND. IPARAM /= GFP_GFIS%IGRIB) THEN
      WRITE(NULOUT,*) 'CLIMATE FIELD NOT USED ... ',IPARAM
      CYCLE
    ELSE
      WRITE(NULOUT,*) 'PARAMETER ',IPARAM,' READ FROM CLIMATE ','FILE'
    ENDIF

!   *     1.2.1    CHECK PARAMETER.

    IF(NFPHTYP /= 0) THEN
      DO JGL=1,NLAT(1)
        IF(NFPRGRI(JGL) /= ISEC2(22+JGL)) THEN
          WRITE(NULOUT,*) ' INCONSISTENT REDUCED GRID'
          WRITE(NULOUT,*) ' IN MODEL ',(NFPRGRI(J),J=1,NLAT(1))
          WRITE(NULOUT,*) ' IN FILE  ',(ISEC2(22+J),J=1,NLAT(1))
          CALL ABOR1('RDECCLIMO')
        ENDIF
      ENDDO
    ENDIF

    IF (IPARAM == GFP_LSM%IGRIB) THEN
      DO J=1,ISEC4(1)
        ZREAL(J)=MAX(0.0_JPRB,SIGN(1.0_JPRB,ZREAL(J)-0.5_JPRB))
      ENDDO
    ENDIF

    PFIELD(:,IFLD)=ZREAL(:)

  ENDDO FIELD_LOOP

!*       2.5 CLOSE FILE

  CALL PBCLOSE(IUNITGG,IRET)

ENDDO

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