SUBROUTINE WROUTGPGB(PGGFLD,KGPTOT,KGPTOTG,KGPTOTMX,KGGMAX,KGRIBIO,&
 & CDLEVTYPE,CDMODE)  

!**** *WROUTGPGB* - GRIB codes and writes out grid-point fields

!     Purpose.
!     --------
!     Write out gridpoint fields in GRIB

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

!        Explicit arguments : PGGFLD  - fields to be written out   
!        -------------------- KGPTOT  - number of gridpoints on your proc.
!                             KGPTOTG - global number of gridpoints 
!                             KGGMAX  - number of fields to write out
!                             KGRIBIO - help array for GRIB coding
!                             CDLEVTYPE - type of level for fields
!                             CDMODE - mode to open files 

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

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

!     Externals.    - PRGRIBENC - modify GRIB headers, output resolution
!     ----------

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

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

!     Modifications.
!     --------------
!       Original : 01-12-14 Adapted from WR****
!       J.Hague(IBM)/M.Hamrud 15-03-02  - Improvements in message passing
!       P.Towers 13-11-02 - Fixes for fewer writers than gatherers
!       John Hague : 13-01-03 WAIT if NPROC=1
!       P.Towers 23-04-03 - Added ISETFIELDCOUNTFDB logic
!        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,    JPIB,     JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCT0   , ONLY : LFPOS   ,NPROC
USE YOMFPCT0 , ONLY : NFPCT0
USE YOMFPC   , ONLY : CFPFMT
USE YOMCT3   , ONLY : NSTEP
USE YOMGRB   , ONLY : NSTEPLPP  
USE YOMLUN   , ONLY : NULOUT
USE YOMOP    , ONLY : CFNGG    ,LINC     ,CFNINGG, CFNBGV
USE YOMMP    , ONLY : NOUTTYPE
USE YOMDYN   , ONLY : TSTEP
USE YOMVAR   , ONLY : LTWINC, NSIM4D, MBGVEC, LTWBGV
USE YOMRIP   , ONLY : NINDAT ,NSSSSS ,NYMLPPGP
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_PUT, &
 & CLOSE_IOSTREAM, TYPE_IOSTREAM , TYPE_IOREQUEST, Y_IOSTREAM_FDB,&
 & CLOSE_IOREQUEST
USE MPL_MODULE , ONLY : MPL_ALLREDUCE

IMPLICIT NONE

INTEGER(KIND=JPIM),PARAMETER :: ISHOUR=3600
INTEGER(KIND=JPIM),PARAMETER :: IHDAY=24

!DUMMY VARIABLES

INTEGER(KIND=JPIM),INTENT(IN)    :: KGPTOT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KGGMAX 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGGFLD(KGPTOT,KGGMAX) 
INTEGER(KIND=JPIM)               :: KGPTOTG ! Argument NOT used
INTEGER(KIND=JPIM)               :: KGPTOTMX ! Argument NOT used
INTEGER(KIND=JPIM),INTENT(IN)    :: KGRIBIO(2,KGGMAX) 
CHARACTER(LEN=1)  ,INTENT(IN)    :: CDLEVTYPE 
CHARACTER(LEN=1)  ,INTENT(IN)    :: CDMODE
!     EXTERNAL INTEGER FUNCTIONS

!LOCAL VARIABLES

INTEGER(KIND=JPIM) :: IINC, IMTS
INTEGER(KIND=JPIM) :: IHOUR
INTEGER(KIND=JPIB) :: ISEC
INTEGER(KIND=JPIM) :: IH0,IJ0,IM0,IA0,IDD,ISS,IHR,IMIN,ISC,IJOUR,IMOIS,IAN,ILMOIS(12)
INTEGER(KIND=JPIM) :: IYM
CHARACTER :: CLEVT*3
CHARACTER :: CLR1*5,CLR2*4,CLR1INC*4
CHARACTER :: CLR3*5,CLR4*5,CLR5*5  !KPP CLR5
CHARACTER :: CLFNGG*30
CHARACTER :: CLFNUA*30
CHARACTER :: CLFNOC*30  !KPP
CHARACTER :: CLFN*30
CHARACTER :: CLFBGV*30
CHARACTER :: CLMODE*1

TYPE(TYPE_IOSTREAM) :: YL_IOSTREAM
TYPE(TYPE_IOREQUEST) :: YL_IOREQUEST

REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB) :: ZGGFLD(KGPTOT,KGGMAX,1)
LOGICAL :: LLFPDIST 

#include "abor1.intfb.h"
#include "fcttim.h"
#include "updcalsec.intfb.h"

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

!  PREPARATIONS

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

IA0=NCCAA(NINDAT)
IM0=NMM(NINDAT)
IJ0=NDD(NINDAT)
IH0=NSSSSS/ISHOUR
IF (NSTEP <= 0) NYMLPPGP=0
ISEC=NINT(NSTEP*TSTEP,KIND(ISEC))
IHOUR=INT(ISEC/ISHOUR,KIND(IHOUR))
IDD=IHOUR/IHDAY
ISS=MODULO(IHOUR,IHDAY)*ISHOUR
CALL UPDCALSEC(IH0,IJ0,IM0,IA0,IDD,ISS,IHR,IMIN,ISC,IJOUR,IMOIS,IAN,ILMOIS,NULOUT)
IYM=IAN*100+IMOIS

ZGGFLD(:,:,1)=PGGFLD(:,:)
IF(CDLEVTYPE == 'm') THEN
  CLEVT='ML'
ELSEIF(CDLEVTYPE == 'p') THEN
  CLEVT='PL'
ELSEIF(CDLEVTYPE == 'v') THEN
  CLEVT='PV'
ELSEIF(CDLEVTYPE == 't') THEN
  CLEVT='TH'
ELSEIF(CDLEVTYPE == 's') THEN
  CLEVT='SFC'
ELSEIF(CDLEVTYPE == 'o') THEN  !KPP
  CLEVT='OML'                  !KPP
ELSE
  CALL ABOR1('WROUTGPGB:UNKNOWN LEVEL TYPE')
ENDIF


! CREATE FILENAMES AND/OR PREPARE FOR WRITING

IF(NOUTTYPE /= 2) THEN  ! Not writing to FDB

  CLFNGG = ' '
  CLR1 = CFNGG(1:5)
  IF (LTWINC) CLR1INC = CFNINGG(1:4)
  CLR2 = CFNGG(6:9)
  CLR3 = 'ICMFP'
  CLR4 = 'ICMUA'
  CLR5 = 'ICMOC'   !KPP
  IF (LINC) THEN
    IINC = NINT(NSTEP*TSTEP/3600._JPRB,KIND(IINC))
  ELSE
    IINC = NSTEP
  ENDIF

  IF (NSTEP < 0) THEN
    IF (LFPOS) THEN
      IF( NFPCT0 < 0 ) THEN
        WRITE(CLFNGG,'(A5,A4,I5.4)') CLR3,CLR2,NSTEP
      ELSE
        WRITE(CLFNGG,'(A5,A4,I5.4)') CLR1,CLR2,NSTEP
        WRITE(CLFNUA,'(A5,A4,I5.4)') CLR4,CLR2,NSTEP
      ENDIF
    ELSE
      WRITE(CLFNGG,'(A5,A4,I5.4)') CLR1,CLR2,NSTEP
    ENDIF
    WRITE(CLFNOC,'(A5,A4,I5.4)') CLR5,CLR2,NSTEP      !KPP  
  ELSE
    IF (LFPOS .AND. NFPCT0 < 0) THEN
        WRITE(CLFNGG,'(A5,A4,''+'',I6.6)') CLR3,CLR2,IINC
    ELSE
      IF(LTWINC) THEN
        IMTS = NINT(NSTEP*TSTEP/60._JPRB,KIND(IMTS))
        IINC = (IMTS/60)*100+MOD(IMTS,60)
        WRITE(CLFNGG,'(A4,A4,I3.3,''+'',I6.6)') CLR1INC,CLR2,NSIM4D,IINC
      ELSE
        WRITE(CLFNGG,'(A5,A4,''+'',I6.6)') CLR1,CLR2,IINC
      ENDIF
      WRITE(CLFNUA,'(A5,A4,''+'',I6.6)') CLR4,CLR2,IINC
    ENDIF
    WRITE(CLFNOC,'(A5,A4,''+'',I6.6)') CLR5,CLR2,IINC      !KPP  
  ENDIF

  IF (LFPOS.AND.NFPCT0 < 0) THEN
    CLFN = CLFNGG
  ELSEIF(LFPOS) THEN
    IF( NFPCT0 /= 0 ) THEN
      IF (NSTEP == 0) THEN
        WRITE(CLFN,'(A10,A6)') CLFNGG(1:10),'000000'
      ELSE
        IF ((NYMLPPGP == 0).OR.(IYM == NYMLPPGP).OR. &
 &         ((IYM /= NYMLPPGP).AND.((IJOUR /= 1).OR.(IHR /= 0)))) THEN
          WRITE(CLFN,'(A10,I6)') CLFNGG(1:10),IYM
        ELSE
          WRITE(CLFN,'(A10,I6)') CLFNGG(1:10),NYMLPPGP
        ENDIF
      ENDIF
    ELSE
      IF(CLEVT == 'SFC') THEN
        CLFN = CLFNGG
      ELSE
        CLFN = CLFNUA
      ENDIF
    ENDIF
  ELSE
    CLFN = CLFNGG
  ENDIF

  IF(CLEVT == 'OML') THEN    !KPP
    CLFN = CLFNOC            !KPP
  ENDIF                      !KPP

ENDIF

IF(LTWBGV) THEN
  CLFBGV=CFNBGV
  WRITE(CLFBGV(7:),'(I3.3)') MBGVEC
  WRITE(CLFBGV(1:2),'(A2)') 'UA'
  CLFN=CLFBGV
ENDIF

IF ((NSTEP <= 0).OR.(NYMLPPGP == 0).OR. &
 & ((IYM /= NYMLPPGP).AND.((IJOUR /= 1).OR.(IHR /= 0)))) THEN
  CLMODE=CDMODE
ELSE
  CLMODE='a'
ENDIF

IF ((NSTEP <= 0).OR.((NYMLPPGP /= 0).AND. &
 & (IYM /= NYMLPPGP).AND.(IJOUR == 1).AND.(IHR == 0))) THEN
  NYMLPPGP = NYMLPPGP
ELSE
  NYMLPPGP = IYM
ENDIF

LLFPDIST=LFPOS .AND. CFPFMT == 'GAUSS' 
CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,&
 & KGRIB2D=KGRIBIO(1,:),KLEVS2D=KGRIBIO(2,:),CDLEVTYPE=CLEVT,&
 & LDFPDIST=LLFPDIST)
IF(NOUTTYPE == 2) THEN
  CALL IO_PUT(Y_IOSTREAM_FDB,YL_IOREQUEST,PR3=ZGGFLD)
ELSE
  CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLFN),CDMODE=CLMODE,KIOMASTER=1)
  CALL IO_PUT(YL_IOSTREAM,YL_IOREQUEST,PR3=ZGGFLD)
  CALL CLOSE_IOSTREAM(YL_IOSTREAM)
ENDIF
 
CALL CLOSE_IOREQUEST(YL_IOREQUEST)

!Make sure everyone knows when a surface parameter was last postprocessed
IF(NPROC > 1 .AND. CLEVT == 'SFC') THEN
  CALL MPL_ALLREDUCE(NSTEPLPP,'MAX',CDSTRING='WROUTGPGB:')
ENDIF

IF (LHOOK) CALL DR_HOOK('WROUTGPGB',1,ZHOOK_HANDLE)

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


END SUBROUTINE WROUTGPGB
