SUBROUTINE WRHFP(CDCONF)

!**** *WRHFP*  - WRITE OUT THE HORIZONTALLY POST-PROCESSED FIELDS TO
!                ARPEGE/ALADIN FILES

!     PURPOSE.
!     --------
!        Extract the post-processed fields, sort out the output points for
!        each domain, then write records on files.

!**   INTERFACE.
!     ----------
!       *CALL* *WRHFP(CDCONF)*

!        EXPLICIT ARGUMENTS
!        --------------------
!        CDCONF : configuration of work

!        IMPLICIT ARGUMENTS
!        --------------------
!         See modules above

!     METHOD.
!     -------
!        SEE DOCUMENTATION
!     Core data is extracted from all processors 
!              and distributed to NSTROUT processors 
!     (Core data + Extension zone) is packed by NSTROUT processors
!     (Core data + Extension zone) is written out to file by 1 processor

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

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

!     AUTHOR.
!     -------
!        RYAD EL KHATIB *METEO-FRANCE*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 98-07-07
!        Modified : 98-12-31 R. El Khatib Substantial rewrite from 
!                   wrhfpsm/dm & wrsfpsm/dm
!    R. El Khatib : change arg. to PREPACKA and GATHFLNM +Fix.
!    R. El Khatib : 00-03-03 Fixes on IO handling for bogussing
!    D.Dent       : 00-09-01 convert from MPE to MPL
!    R. El Khatib : 00-11-02 Proper merge with extgpf
!    R. El Khatib : 01-03-16 IDATEF(10)=time of previous event ; 
!                   N3DINI for tests
!    R. El Khatib : 01-08-07 Pruning options
!    R. El Khatib : 02-21-20 Fullpos B-level distribution + remove IO scheme
!    R. El Khatib : 03-04-17 Fullpos improvments
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning
!    R. El Khatib : 05-02-22 Change interface to SUPPDATE
!    R. El Khatib : 05-03-03 Prints out limited with epsilon(1.)
!    R. El Khatib : 12-Jan-2009 Bugfix on top of the prints above
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NPROC    ,N3DINI
USE PARFPOS  , ONLY : JPOSLEN  ,JPOSDIR
USE YOMFPC   , ONLY : CFPIDEN  ,NFPDOM   ,NFPGRIB  ,&
 & NFPINCR   ,CFPDOM  ,CFPFMT  
USE YOMFPG   , ONLY : LFPEZO
USE YOMFPIOS , ONLY : NFPXFLD
USE YOMDFPB  , ONLY : NLENHFPB ,HFPBUF   ,NSTAHFPB
USE YOMAUXB  , ONLY : GAUXBUF
USE YOMCT1   , ONLY : LRFILAF
USE YOMFPOP  , ONLY : CFPCA
USE YOMMP    , ONLY : MYPROC ,NSTROUT
USE YOMFPCT0 , ONLY : NFPCT0
USE YOMXFU   , ONLY : NRAZTS   ,JPFUXT   ,NFRRAZ   ,N1RAZ    ,LXFU
USE MPL_MODULE, ONLY : MPL_BARRIER

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
!     CLP     : prefix of field names
!     CLSUFF  : suffix of field names
!     ILEV    : field level to be written out on file
!     INBIT   : Number of bits for coding
!     IFIELDST: total number of fields to be extracted
!     IPTR    : pointer of each subdomain in the global output array
!     IPTR0   : pointer of each subdomain in the global output array before 
!               packing
!     ISIZEG  : global size of a field for each subdomain (including Ezone)
!     ISIZPK  : overdimensionned value of ISIZEG for safety while packing
!     IREC    : number of fields to be written out on file
!     LLDYN   : .TRUE. if dynamic fields conf. ; else physical fields

!     IZVAL: number of points in the global output array to be written
!               out on file(s), overdimensionned by 2 for safety 
!               while packing. 

!     IFLDSCH: maximum number of fields in a chunk
!     ICHUNKS: number of chunks of fields
!     LLFIRST: current chunk is the first one
!     LLLAST : current chunk is the last one
!     LLOPEN : file to be opened
!     LLCLOSE: file to be close
!     LLBOGUS: "bogussing" active
!     LLCOM  : included communications in extgpf, na !
!     IBFA   : Absolute first field to be extracted
!     IEFA   : Absolute last  field to be extracted
!     INFG   : total number of fields in the current chunk
!     INFL   : local number of fields in the current chunk
!     INFD   : number of fields in the current chunk for each processor
!     IFLDOFF: fields offset after distribution among NSTROUT procs.

!     ZREAD  : extracted and sorted fields for a processor-set of fields
!     ZAVED  : mean    values per domain for a processor-set of fields
!     ZMIND  : minimum values per domain for a processor-set of fields
!     ZMAXD  : maximum values per domain for a processor-set of fields
!     CLNMAD : fields names for a processor-set of fields
!     ILOGAD : actual length of a field for a processor-set of fields
!     INOMAD : actual actual of a field name for a processor-set of fields
!     IMASKD : binary mask ; =0 to skip the field (no write out) ; else =1
!              for a processor-set of fields
!     ZREAL  : extracted and sorted fields for the local set of fields
!     ZAVEL  : mean    values per domain for the local set of fields
!     ZMINL  : minimum values per domain for the local set of fields
!     ZMAXL  : maximum values per domain for the local set of fields
!     CLNMAL : fields names for the local set of fields
!     ILOGAL : actual length of fields for the local set of fields
!     INOMAL : actual length of a field name for the local set of fields
!     IMASKL : binary mask ; =0 to skip the field (no write out) ; else =1
!              for the local set of field

!     IFILE  : kind of file to open
!     IDTIME : time indicator ;
!              1 = date of the starting file + model forecast range
!     IDATEF : date in initial file
!     CLFPFN : complete filename
!     IULFP  : logical unit number of output files
!     CLFPCA : output file framework

!     IOUTPROC: processor number writing out to files

INTEGER(KIND=JPIM) :: IPTR(NFPDOM), IPTR0(NFPDOM),IREC(NFPDOM)
INTEGER(KIND=JPIM) :: ISIZEG(NFPDOM), ISIZPK(NFPDOM)

INTEGER(KIND=JPIM) :: INFD(NPROC), IFLDOFF(NPROC)

CHARACTER (LEN=(JPOSDIR+4+JPOSLEN+5)) :: CLFPFN(NFPDOM)
CHARACTER (LEN = 16) ::  CLPRINT, CLFPCA(NFPDOM)
INTEGER(KIND=JPIM) :: IULFP(NFPDOM), IDATEF(11)

REAL(KIND=JPRB),     ALLOCATABLE :: ZREAL(:,:), ZREAD(:,:)
REAL(KIND=JPRB)     ,ALLOCATABLE :: ZAVEL(:,:), ZMINL(:,:), ZMAXL(:,:)
REAL(KIND=JPRB)     ,ALLOCATABLE :: ZAVED(:,:), ZMIND(:,:), ZMAXD(:,:)
INTEGER(KIND=JPIM)  ,ALLOCATABLE :: IMASKL(:,:), IMASKD(:,:)
INTEGER(KIND=JPIM),  ALLOCATABLE :: INOMAL(:,:), ILOGAL(:,:)
INTEGER(KIND=JPIM),  ALLOCATABLE :: INOMAD(:,:), ILOGAD(:,:)
CHARACTER(LEN=16),ALLOCATABLE :: CLNMAL(:,:), CLNMAD(:,:)
CHARACTER(LEN=8),ALLOCATABLE :: CLP(:)
CHARACTER(LEN=12),ALLOCATABLE :: CLSUFF(:)
INTEGER(KIND=JPIM),  ALLOCATABLE :: ILEV(:), INBIT(:), IFLDPT(:)

INTEGER(KIND=JPIM) :: IBFA, ICHUNKS, IEFA, IFIELDST, IFLDSCH, INBARP,&
 & INFG, INFL, INIMES, IOFFL, IOUTPROC, IP, &
 & IREP, ITAG, IZVAL, JCH, JD, JFLD, &
 & JROC, IDTIME, IFILE, ILEN  

LOGICAL :: LLFIRST, LLLAST, LLOPEN, LLCLOSE, LLBOGUS, LLEXIST
LOGICAL :: LLCOSP, LLDYN, LLIMST, LLFICP, LLCOM
REAL(KIND=JPRB) :: ZEPS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "exarp.intfb.h"
#include "exbip.intfb.h"
#include "extfpf.intfb.h"
#include "extgpf.intfb.h"
#include "fpgpnorm.intfb.h"
#include "gathflnm.intfb.h"
#include "ini1wrfp.intfb.h"
#include "ini2wrfp.intfb.h"
#include "ini3wrfp.intfb.h"
#include "newfa.intfb.h"
#include "openfpfa.intfb.h"
#include "prepacka.intfb.h"
#include "sumpioh.intfb.h"
#include "suppdate.intfb.h"

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

!*       1. PREPARE FOR EXTRACTING DATA AND WRITING OUT TO FILE
!           ---------------------------------------------------

!     Preparations for reading in and writing out :

IF (LHOOK) CALL DR_HOOK('WRHFP',0,ZHOOK_HANDLE)
LLBOGUS=NFPINCR /= 0.AND.NFPCT0 /= 0
LLCOSP=.FALSE.
CALL INI1WRFP(CDCONF,LLCOSP,IFIELDST,IPTR0,IREC,LLDYN,ISIZEG,ISIZPK)

IZVAL=0
DO JD=1,NFPDOM
  IZVAL=IZVAL+ISIZPK(JD)
ENDDO

LLCOM=.TRUE.

!     Maximum size of fields chunks : 
IF (NFPXFLD <= 0) THEN
  IFLDSCH=IFIELDST
ELSE
  IFLDSCH=NFPXFLD
ENDIF

ICHUNKS=(IFIELDST-1)/IFLDSCH+1

IOUTPROC=1

IF (MYPROC == IOUTPROC) THEN
  INIMES = 0
  LLIMST=.TRUE.
  CALL INI3WRFP(CLFPFN,CLFPCA,IULFP,INBARP,NFPCT0)
  IDTIME=1-N3DINI
  IF (LXFU) THEN
    CALL SUPPDATE(IDTIME,NRAZTS,JPFUXT,NFRRAZ,N1RAZ,IDATEF)
  ELSE
    CALL SUPPDATE(KDTIME=IDTIME,KDIME=1,KPPDATE=IDATEF)
  ENDIF
ENDIF

ALLOCATE(IFLDPT(IFIELDST))

!*       2. EXTRACT DATA, DISTRIBUTE IT TO "I/O" PROCS. THEN WRITE OUT
!           ----------------------------------------------------------

CHUNKS_LOOP : DO JCH=1,ICHUNKS
!     -----------

  LLFIRST=JCH == 1
  LLLAST=JCH == ICHUNKS
  IPTR(:)=IPTR0(:)

!*       2.1 SETUP DISTRIBUTION AMONG "I/O" PROCS (<=> INFL>0)

  IBFA=(JCH-1)*IFLDSCH+1
  IEFA=MIN(JCH*IFLDSCH,IFIELDST)
  INFG=IEFA-IBFA+1
  CALL SUMPIOH(INFG,NPROC,NSTROUT,INFD,IFLDOFF)
  INFL=INFD(MYPROC)

!*       2.2 EXTRACT CORE AND POSSIBLY E-ZONE, DISTRIBUTE TO "I/O" PROCS

  ALLOCATE(ZREAL(IZVAL,INFL))

  IF    (LLDYN .AND. (CFPFMT == 'MODEL')) THEN
    DO JFLD=1,IFIELDST
      IFLDPT(JFLD)=JFLD
    ENDDO
    CALL EXTGPF(INFG,GAUXBUF,IFLDPT,IBFA,ZREAL,INFL,IZVAL,INFD,IFLDOFF,LLCOM)
  ELSE
    CALL EXTFPF(INFG,INFL,IFIELDST,HFPBUF,NLENHFPB,NSTAHFPB,IBFA,ZREAL,IZVAL, &
     & INFD,IFLDOFF)  
    IF (LFPEZO) THEN
      CALL EXBIP(IBFA,INFG,ZREAL,IZVAL,INFL,INFD,IFLDOFF,IFIELDST)
    ENDIF
  ENDIF

!*       2.3 "I/O" PROCESSORS ARE PRECONDITIONNING DATA 

  IF (INFL > 0) THEN

!*        2.3.1 Setup parameters for packing and field name construction

    ALLOCATE(CLP(INFL))
    ALLOCATE(ILEV(INFL))
    ALLOCATE(CLSUFF(INFL))
    ALLOCATE(INBIT(INFL))
    ALLOCATE(IMASKL(INFL,NFPDOM))

    IOFFL=IBFA-1+IFLDOFF(MYPROC)
    CALL INI2WRFP(CDCONF,LLDYN,LLCOSP,INFL,NFPDOM,IOFFL,CLP,&
     & CLSUFF,ILEV,INBIT,IMASKL)  

!*        2.3.2 Read background data and combine with extracted data if 
!               bogussing

    IF (LLBOGUS) THEN
      LLOPEN=.TRUE.
      LLCLOSE=.TRUE.
      CALL EXARP(ZREAL,CLP,ILEV,CLSUFF,INFL,ISIZEG,IZVAL,LLOPEN,LLCLOSE)
    ENDIF

!*        2.3.3 Compute norms

    ALLOCATE(ZAVEL(INFL,NFPDOM))
    ALLOCATE(ZMINL(INFL,NFPDOM))
    ALLOCATE(ZMAXL(INFL,NFPDOM))

    ZEPS=EPSILON(1._JPRB)
    DO JD=1,NFPDOM
      CALL FPGPNORM(ZREAL,INFL,IZVAL,IMASKL(1,JD),ZAVEL(1,JD),ZMINL(1,JD),&
       & ZMAXL(1,JD),IPTR(JD),ISIZEG(JD))  
      DO JFLD=1,INFL
        IF (IMASKL(JFLD,JD) == 1) THEN
          IF (ABS(ZAVEL(JFLD,JD)) < ZEPS) ZAVEL(JFLD,JD)=0._JPRB
          IF (ABS(ZMINL(JFLD,JD)) < ZEPS) ZMINL(JFLD,JD)=0._JPRB
          IF (ABS(ZMAXL(JFLD,JD)) < ZEPS) ZMAXL(JFLD,JD)=0._JPRB
        ENDIF
      ENDDO
    ENDDO

!*        2.3.4 Pack data

    ALLOCATE(ILOGAL(INFL,NFPDOM))
    ALLOCATE(CLNMAL(INFL,NFPDOM))
    ALLOCATE(INOMAL(INFL,NFPDOM))

    CALL PREPACKA(NFPDOM,ZREAL,CLP,ILEV,CLSUFF,INFL,IZVAL,IMASKL,LLCOSP,&
     & NFPGRIB,INBIT,CFPCA,INOMAL,ILOGAL,CLNMAL,IPTR,ISIZEG,ISIZPK)  

!*        2.3.5 Send packed data, names & norms in a single message

    IF (MYPROC /= IOUTPROC) THEN
      ITAG=MYPROC+(JCH-1)*NPROC
      CALL GATHFLNM(0,ITAG,INFL,NFPDOM,CLNMAL,INOMAL,ZREAL,&
       &ILOGAL,IMASKL,IZVAL,ZAVEL,ZMINL,ZMAXL,.TRUE.,IPTR)
      DEALLOCATE(IMASKL)
      DEALLOCATE(ZAVEL)
      DEALLOCATE(ZMINL)
      DEALLOCATE(ZMAXL)
      DEALLOCATE(ILOGAL)
      DEALLOCATE(CLNMAL)
      DEALLOCATE(INOMAL)
    ENDIF

!*        2.3.6 Release useless arrays

    DEALLOCATE(INBIT)
    DEALLOCATE(CLSUFF)
    DEALLOCATE(ILEV)
    DEALLOCATE(CLP)

  ENDIF

!*       2.4 OUTPUT PROCESSOR COLLECTS DATA AND WRITE OUT TO FILES

  IF (MYPROC == IOUTPROC) THEN

    IF (LLBOGUS) THEN
      LLOPEN=.TRUE.
      LLCLOSE=.TRUE.
    ELSE
      LLOPEN=LLFIRST
      LLCLOSE=LLLAST
    ENDIF

!*        2.4.1 Open files if first chunk and if file is not already opened 
!               by EXARP

    IF (LLOPEN) THEN
      DO JD=1,NFPDOM
        IF (IREC(JD) > 0) THEN
          INQUIRE(FILE=CLFPFN(JD),EXIST=LLEXIST)
          IF (LLEXIST) THEN
            IFILE=0
            CALL OPENFPFA(JD,IULFP(JD),CLFPFN(JD),IFILE,IDATEF,&
             & ILEN,ILEN,LLFICP,.FALSE.)  
          ELSE
            CALL NEWFA(INBARP,CLFPCA(JD),IULFP(JD),CLFPFN(JD),LLIMST,&
             & INIMES,CFPIDEN,IDATEF)  
          ENDIF
        ENDIF
      ENDDO
    ENDIF

    IF (LLFIRST) THEN
!     Print title the first time : 
      WRITE(NULOUT,FMT='(''FULL-POS GPNORMS'')')
      WRITE(NULOUT,FMT='(29X,3(6X,A7,9X))')'AVERAGE','MINIMUM','MAXIMUM'
    ENDIF

!*        2.4.3 Write out data and norms

    DO JROC=1,NPROC
      IF (INFD(JROC) > 0) THEN

        IF (JROC == MYPROC) THEN
!               use my own data :
          DO JFLD=1,INFL
            DO JD=1,NFPDOM
              IP=IPTR(JD)
              IF (IMASKL(JFLD,JD) == 1) THEN
                CALL FAISAN(IREP,IULFP(JD),&
                 & CLNMAL(JFLD,JD)(1:INOMAL(JFLD,JD)),&
                 & ZREAL(IP,JFLD),ILOGAL(JFLD,JD))  
                CLPRINT=CLNMAL(JFLD,JD)(1:INOMAL(JFLD,JD))//' '
                WRITE(NULOUT,FMT='(1X, A16,''/'',A7,'' : '',&
                 & 3(E21.15,1X))') CLPRINT,CFPDOM(JD),&
                 & ZAVEL(JFLD,JD),ZMINL(JFLD,JD),ZMAXL(JFLD,JD)  
              ENDIF
            ENDDO
          ENDDO
          DEALLOCATE(IMASKL)
          DEALLOCATE(ZAVEL)
          DEALLOCATE(ZMINL)
          DEALLOCATE(ZMAXL)
          DEALLOCATE(CLNMAL)
          DEALLOCATE(ILOGAL)
          DEALLOCATE(INOMAL)
        ELSE
!               collect data from the I/O processor :
          ALLOCATE(ZREAD(IZVAL,INFD(JROC)))
          ALLOCATE(ZAVED(INFD(JROC),NFPDOM))
          ALLOCATE(ZMIND(INFD(JROC),NFPDOM))
          ALLOCATE(ZMAXD(INFD(JROC),NFPDOM))
          ALLOCATE(ILOGAD(INFD(JROC),NFPDOM))
          ALLOCATE(IMASKD(INFD(JROC),NFPDOM))
          ALLOCATE(CLNMAD(INFD(JROC),NFPDOM))
          ALLOCATE(INOMAD(INFD(JROC),NFPDOM))
          ITAG=JROC+(JCH-1)*NPROC
          CALL GATHFLNM(1,ITAG,INFD(JROC),NFPDOM,CLNMAD,INOMAD,&
           &ZREAD,ILOGAD,IMASKD,IZVAL,ZAVED,ZMIND,ZMAXD,.TRUE.,IPTR)
          DO JFLD=1,INFD(JROC)
            DO JD=1,NFPDOM
              IP=IPTR(JD)
              IF (IMASKD(JFLD,JD) == 1) THEN
                CALL FAISAN(IREP,IULFP(JD),&
                 & CLNMAD(JFLD,JD)(1:INOMAD(JFLD,JD)),&
                 & ZREAD(IP,JFLD),ILOGAD(JFLD,JD))  
                CLPRINT=CLNMAD(JFLD,JD)(1:INOMAD(JFLD,JD))//' '
                WRITE(NULOUT,FMT='(1X, A16,''/'',A7,'' : '',&
                 & 3(E21.15,1X))') CLPRINT,CFPDOM(JD),&
                 & ZAVED(JFLD,JD),ZMIND(JFLD,JD),ZMAXD(JFLD,JD)  
              ENDIF
            ENDDO
          ENDDO
          DEALLOCATE(ZREAD)
          DEALLOCATE(ZAVED)
          DEALLOCATE(ZMIND)
          DEALLOCATE(ZMAXD)
          DEALLOCATE(CLNMAD)
          DEALLOCATE(ILOGAD)
          DEALLOCATE(IMASKD)
          DEALLOCATE(INOMAD)
        ENDIF

      ENDIF
    ENDDO

!*        2.4.4 Close files if last chunk and if file is not already closed
!               by EXARP

    IF (LLCLOSE) THEN
      DO JD=1,NFPDOM
        IF (IREC(JD) > 0) THEN
          IF (LRFILAF) THEN
            CALL LFILAF(IREP,IULFP(JD),.FALSE.)
          ENDIF
          CALL LFIMST(IREP,IULFP(JD),.FALSE.)
          CALL FAIRME(IREP,IULFP(JD),'KEEP')
        ENDIF
      ENDDO
    ENDIF

  ENDIF

!*       2.5 RELEASE ARRAYS BEFORE NEXT CHUNK

  DEALLOCATE(ZREAL)

!*       2.6 SYNCHRONIZATION IN BOGUSSING

  IF (NPROC > 1) THEN
    CALL MPL_BARRIER(CDSTRING='WRHFP:')
  ENDIF

ENDDO CHUNKS_LOOP
! ---------------

DEALLOCATE(IFLDPT)

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