SUBROUTINE SUFPSC2

!**** *SUFPSC2*  - FULL-POS HORIZONTAL SCANNING

!     PURPOSE.
!     --------
!        TO SET UP MODULE YOMFPSC2 WHICH CONTAINS THE CONTROL PARAMETERS AND
!        ARRAYS TO SCAN THE POST-PROCESSING BUFFERS PER ROW
!        DM-features linked to arrival geometry.

!        The following variables (in YOMFPSC2) are computed:
!         NFPROMA
!         NFPBLOCS, NFPSTART, NFPEND, NFPSORT, NFPBLOFF

!**   INTERFACE.
!     ----------
!       *CALL* *SUFPSC2*

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

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

!     METHOD.
!     -------
!        SEE DOCUMENTATION ABOUT FULL-POS

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

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

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

!     MODIFICATIONS.
!     --------------
!      G. Radnoti   : 95-01-23   full pos of aladin
!      R. El Khatib : 95-11-08   initialisation of NFPROMA
!      Modified by K. YESSAD (MARCH 1997): 
!          - parallelisation of FULL-POS.
!      Modified by N. WEDI (SUMMER 1997): corrections of bugs in the DM code.
!      Modified by V. SARAVANE (OCT 1997): some optimisations.
!      Modified : ??-??-?? J.Latour ?? tidied up by M.Hamrud
!      R. El Khatib : 98-07-29 Unification SM/DM ; communicate row length
!      R. El Khatib : 98-10-06 LFPOSBUF ; SUFPSORT ; reunification of scanning
!      R. El Khatib : 03-01-29 Remove SM aspects/cleanings
!      R. El Khatib : 03-04-17 Fullpos improvments
!      M.Hamrud     : 01-Oct-2003 CY28 Cleaning
!      R. El Khatib : 23-may-2005 NFPBLOFF
!      M. Jidane    : 19-04-2006  Correction of a bug in allocation of NFPBLOFF
!      K. Yessad    : 27-Feb-2007 Adapt to arrival geometry, clean.
!-----------------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT   ,NULNAM
USE YOMDIM   , ONLY : NPROMA
USE YOMFPG   , ONLY : NFPRGPL  ,LFPOSBUF
USE YOMFPSC2 , ONLY : NFPBLOCS ,NFPROMA  ,NFPSTART ,NFPEND   ,NFPSORT  ,NFPBLOFF
USE YOMFPC   , ONLY : LTRACEFP

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

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IBLOC, IPROMA, IRANK, J

CHARACTER(LEN=39) :: CLFMT='(1X,''ARRAY '',A10,'' ALLOCATED '',8I8)'
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "namfpsc2.h"

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

#include "abor1.intfb.h"
#include "posnam.intfb.h"

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

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

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

!*       1. COMPUTES SEGMENTATION 
!           ---------------------

SELECT CASE (LFPOSBUF)

CASE (.TRUE.)

  !      1.1 Read namelist & control

  NFPROMA=NPROMA
  CALL POSNAM(NULNAM,'NAMFPSC2')
  READ(NULNAM,NAMFPSC2)

  IPROMA=MIN(NFPROMA,NFPRGPL)
  NFPROMA=MAX(1,IPROMA+1-MOD(IPROMA,2))

CASE DEFAULT

  ! Use model-shaped buffer segmentation :
  NFPROMA=NPROMA

END SELECT

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

!*       2. COMPUTES NUMBER OF BLOCS AND RELATED CONTROL ARRAYS
!           ---------------------------------------------------

SELECT CASE (NFPRGPL)
CASE (1:)
  NFPBLOCS=(NFPRGPL-1)/NFPROMA +1
CASE (0)
  NFPBLOCS=0
CASE DEFAULT
  CALL ABOR1('SUFPSC2:ILLEGAL VALUE NFPRGPL')
END SELECT

IF (ALLOCATED(NFPSTART)) DEALLOCATE(NFPSTART)
ALLOCATE(NFPSTART(NFPBLOCS))
IF (ALLOCATED(NFPEND)) DEALLOCATE(NFPEND)
ALLOCATE(NFPEND(NFPBLOCS))
IF (ALLOCATED(NFPBLOFF)) DEALLOCATE(NFPBLOFF)
ALLOCATE(NFPBLOFF(NFPBLOCS))
IF (LTRACEFP) THEN
  WRITE(NULOUT,CLFMT) 'NFPSTART ',SIZE(NFPSTART),SHAPE(NFPSTART)
  WRITE(NULOUT,CLFMT) 'NFPEND   ',SIZE(NFPEND),SHAPE(NFPEND)
  WRITE(NULOUT,CLFMT) 'NFPBLOFF ',SIZE(NFPBLOFF),SHAPE(NFPBLOFF)
ENDIF
DO J=1,NFPBLOCS-1
  NFPSTART(J)=1
  NFPEND  (J)=NFPROMA
  NFPBLOFF(J)=NFPROMA*(J-1)
ENDDO
IF (NFPBLOCS > 0) THEN
  NFPSTART(NFPBLOCS)=1
  NFPEND  (NFPBLOCS)=NFPRGPL-NFPROMA*(NFPBLOCS-1)
  NFPBLOFF(NFPBLOCS)=NFPROMA*(NFPBLOCS-1)
ENDIF

IF (ALLOCATED(NFPSORT)) DEALLOCATE(NFPSORT)
ALLOCATE(NFPSORT(NFPROMA,NFPBLOCS))
IF (LTRACEFP) WRITE(NULOUT,CLFMT) 'NFPSORT   ',SIZE(NFPSORT),SHAPE(NFPSORT)
DO J=1,NFPRGPL
  IBLOC=(J-1)/NFPROMA+1
  IRANK=J-(IBLOC-1)*NFPROMA
  NFPSORT(IRANK,IBLOC)=J
ENDDO

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

!*       3.  PRINT OUT FINAL VALUES
!            ----------------------

IF (LTRACEFP) THEN

  WRITE(NULOUT,'(A)') ' '
  WRITE(NULOUT,'('' MODULE YOMFPSC2 '')')
  WRITE(NULOUT,'('' NFPROMA = '',I6,'' NFPBLOCS = '',I6)') NFPROMA, NFPBLOCS
  WRITE(NULOUT,'('' (IBLOC NFPSTART NFPEND) '')')
  WRITE(NULOUT,'(4(1X,''('',I4,2I6,'')''))') &
   & (J,NFPSTART(J),NFPEND(J), J=1, NFPBLOCS)  

ENDIF

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

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