SUBROUTINE SUFPG

USE YOMFPEZO , ONLY : NSTREFP  ,NFPROMEL ,NFPEL    ,NFPEX    ,NFPEG    , &
 &                    NFPEBLKS
!**** *SUFPG*  - INITIALIZE OUTPUT GEOMETRY (Full-POS)

!     PURPOSE.
!     --------
!        Initialize geometry, control points inside the model area (Aladin)
!        and distribute.

!**   INTERFACE.
!     ----------
!       *CALL* *SUFPG*

!        EXPLICIT ARGUMENTS
!        --------------------
!        NONE

!        IMPLICIT ARGUMENTS
!        --------------------
!        See modules below

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

!     EXTERNALS.
!     ----------
!     see includes below

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

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

!     MODIFICATIONS.
!     --------------
!        940408 ORIGINAL
!        9503   K.YESSAD    - Remove useless LCUD in dummy arguments of SUNMEN.
!        9607   P.Le Moigne - Computation of NFPMAX and NMFPMAX protected.
!        9702   R.ElKhatib,V.Casse - Rotation of winds + split into SUFPG1
!               and SUFPG2
!        9703   K. YESSAD: parallelisation of FULL-POS.
!        971024 C. Fischer - add DM computation of NUMPROCFP for Aladin
!        9804   J. Latour (Fujitsu) optimizations
!        98-07-07  R. El Khatib (Move computation of NFPD1 from SUFPD)
!        98-08-10  K. YESSAD: removal of LFPOLE option.
!                  - removal of LFPOLE in YOMFPG.
!        98-08-28  R. El Khatib (case LFPMAP and more detailed comments)
!        98-09-10  G. Radnoti (call SUFPEZO and SUEFPG2 for ezone computations)
!        98-10-01  R. El Khatib (LLSAME, LFPEZO, SUEFPG3, SUMPFPOS)
!        Modified : 98-12-17  R. El Khatib (Case aladin to arpege)
!        00-10-24  R. El Khatib (biperiodicisation of map factor if lelam+.not.lfposbuf)
!        R. El Khatib : 01-08-07 Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K. Yessad: 27-02-2007 Optimisation of distribution in FULL-POS
!-----------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : LFPOS    ,LELAM    ,NPROC
USE YOMFPC   , ONLY : NFPDOM   ,LTRACEFP ,NFPSURFEX
USE YOMFPD   , ONLY : NFPSIZEG
USE YOMFPG   , ONLY : NFPRGPG  ,LFPOSHOR ,LFPEZO   ,LFPOSBUF ,LFPDISTRIB

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

IMPLICIT NONE

!     IFPRGP : number of points on the global and complete output grid(s)
!     ZFPxxx : fields computed on the global output grid(s)
!     LLSAME : .TRUE. if the output grid is the same as the input one

REAL(KIND=JPRB),    ALLOCATABLE :: ZFPLA(:), ZFPLO(:)
REAL(KIND=JPRB),    ALLOCATABLE :: ZFPGM(:), ZFPNORX(:), ZFPNORY(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IFPNUMD(:)

INTEGER(KIND=JPIM) :: IFPRGP, IPTR, JDOM

LOGICAL :: LLSAME, LLAMBUF, LLESAME
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "suefpg3.intfb.h"
#include "sufpezo.intfb.h"
#include "sufpg1.intfb.h"
#include "sufpg2.intfb.h"
#include "sumpfpos.intfb.h"
#include "sumpfpos_dep.intfb.h"

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

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

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

!*       1. COMPUTE PARAMETERS OF OUTPUT GRID(S) (NAMELIST)
!           -----------------------------------------------


! for the time being, default value of LFPDISTRIB is always .FALSE.
LFPDISTRIB=.FALSE.
!later LFPDISTRIB=(NFPSURFEX==1).AND.(NPROC > 1)

CALL SUFPG1(IFPRGP,LLSAME,LFPEZO,LLESAME)

IF (LFPOS.AND.IFPRGP > 0) THEN

!*       2. GLOBAL COORDINATES, MAP FACTOR AND RELATIVE COMPASS
!           ---------------------------------------------------

  ALLOCATE(ZFPLA(IFPRGP))
  ALLOCATE(ZFPLO(IFPRGP))
  ALLOCATE(ZFPGM(IFPRGP))
  ALLOCATE(ZFPNORX(IFPRGP))
  ALLOCATE(ZFPNORY(IFPRGP))
  CALL SUFPG2(IFPRGP,LLSAME,LFPOSHOR,ZFPLA,ZFPLO,ZFPGM,ZFPNORX,ZFPNORY)

!*       3. SUBDOMAIN INDEX
!           ---------------

  ALLOCATE(IFPNUMD(IFPRGP))
  IPTR=0
  DO JDOM=1,NFPDOM
    IFPNUMD(IPTR+1:IPTR+NFPSIZEG(JDOM))=JDOM
    IPTR=IPTR+NFPSIZEG(JDOM)
  ENDDO

!*       4. SELECT POINTS INSIDE THE GLOBAL MODEL DOMAIN & GLOBAL DIMENSIONS
!           ----------------------------------------------------------------

  IF (LELAM.AND.LFPOSHOR) THEN
    CALL SUEFPG3(IFPRGP,ZFPLA,ZFPLO,ZFPGM,ZFPNORX,ZFPNORY,IFPNUMD,NFPRGPG)
  ELSE
    NFPRGPG=IFPRGP
  ENDIF

!*       5. DECIDE ON THE SHAPE OF POST-PROCESSING BUFFERS
!           ----------------------------------------------

  ! Use model-shaped buffer if input grid and output grid are exactly identical:
  IF (.NOT.LELAM) THEN
    LFPOSBUF=.NOT.LLSAME
  ELSE
    LFPOSBUF=.NOT.LLESAME
  ENDIF

  IF (LFPDISTRIB .AND. .NOT.((NPROC>1).AND.LFPOSBUF)) THEN
    WRITE (NULOUT,*) ' LFPDISTRIB has been reset to F.'
  ENDIF
  LFPDISTRIB=LFPDISTRIB.AND.(NPROC>1).AND.LFPOSBUF 

  IF ((NPROC>1).AND.(NFPSURFEX==1).AND.LFPOSBUF.AND.(.NOT.LFPDISTRIB)) THEN
    CALL ABOR1(' SUFPG: (NFPSURFEX==1).AND.LFPOSBUF => LFPDISTRIB should be T')
  ENDIF

!*       6. EXTENSION ZONE : SETUP & DISTRIBUTION
!           -------------------------------------

  LLAMBUF=LELAM.AND..NOT.LFPOSBUF
  IF (LFPEZO.OR.LLAMBUF) THEN
    CALL SUFPEZO(LLAMBUF,ZFPGM,ZFPNORX,ZFPNORY)
  ELSE
    NSTREFP=1
    NFPROMEL=0
    NFPEL=0
    NFPEX=0
    NFPEG=0
    NFPEBLKS=0
  ENDIF

!*       7. CORE : DISTRIBUTION
!           -------------------

  CALL SUMPFPOS_DEP(LFPOSBUF,ZFPLA,ZFPLO,IFPNUMD)
  CALL SUMPFPOS(LFPOSBUF,ZFPLA,ZFPLO,ZFPGM,ZFPNORX,ZFPNORY)

!*       8. FINAL PRINTS OUT
!           ----------------

  IF(LTRACEFP) THEN
    WRITE(NULOUT,'('' SUFPG PRINTS OUT : '')')
    WRITE(UNIT=NULOUT,FMT='('' LFPOSHOR = '',L2,'' LFPEZO = '',L2,&
     & '' LLSAME = '',L2,'' LLESAME = '',L2,'' LFPOSBUF = '',L2)') LFPOSHOR,&
     & LFPEZO,LLSAME, LLESAME, LFPOSBUF  
    WRITE(UNIT=NULOUT,FMT='('' LFPDISTRIB = '',L2)') LFPDISTRIB
    WRITE(UNIT=NULOUT,FMT='('' NFPRGPG = '',I6)') NFPRGPG
  ENDIF

  DEALLOCATE(ZFPLA)
  DEALLOCATE(ZFPLO)
  DEALLOCATE(ZFPGM)
  DEALLOCATE(ZFPNORX)
  DEALLOCATE(ZFPNORY)
  DEALLOCATE(IFPNUMD)

ENDIF

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

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