SUBROUTINE FPSPNORM(PSPEC,KFLDLOC,KFLDG,KOUTPROC,KSETV,KLOC,PAVEG)

!**** *FPSPNORM*  - COMPUTE SPECTRAL NORMS - FULLPOS

!     PURPOSE.
!     --------
!        To compute the spectral norms of the vertically post-processed fields 
!        and send the results to the processor in charge of outputs.

!**   INTERFACE.
!     ----------
!       *CALL* *FPSPNORM*

!        EXPLICIT ARGUMENTS
!        ------------------
!          PSPEC   : Spectral array
!          KFLDLOC : Local number of fields
!          KFLDG   : Global number of fields
!          KOUTPROC: processor to receive the global norms
!          PAVEG   : global norms of the fields
!          KSETV   : V-set each global field belongs to
!          KLOC    : local adress for each global field

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

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

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

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

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 99-02-03 R. El Khatib from WRSFPDM
!        Modified : 00-01-10 D. Dent : add parameter KFLSUR
!    R. El Khatib : 02-21-20 Fullpos B-level distribution + remove IO scheme
!        M.Hamrud : 01-Oct-2003 CY28 Cleaning
!     J. Cedelnik : 26-Feb-2008 Bugfix
!     --------------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NSPECG   ,NSPEC2   ,NUMP
USE YOMMP    , ONLY : MYPROC
USE YOMCT0   , ONLY : LELAM

IMPLICIT NONE
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDLOC 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDG 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPEC(KFLDLOC,NSPEC2) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOUTPROC 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSETV(KFLDG) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLOC(KFLDG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAVEG(KFLDG) 
!     ZSNAL  : local  spectrum at constant n
!     ZSMAL  : local  spectrum at constant m
!     ZSMAG  : global spectrum at constant m
!     ZMET   : Metric
!     ZAVE   : average of all norms
!     ISMAX  : zonal truncation

REAL(KIND=JPRB) :: ZMET(NSPECG), ZAVE, ZDUM
REAL(KIND=JPRB) :: ZSNAL(KFLDLOC,NUMP), ZSMAL(KFLDLOC,NUMP)
REAL(KIND=JPRB), ALLOCATABLE :: ZSMAG(:,:), ZMETDER(:), ZMETKE(:)
LOGICAL :: LLKE, LLNWAVE
INTEGER(KIND=JPIM) :: ISMAX
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "commspnorm1.intfb.h"
#include "spnormave.intfb.h"
#include "spnormbl.intfb.h"
#include "suemetric.intfb.h"
#include "sumetric.intfb.h"

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

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

IF (LHOOK) CALL DR_HOOK('FPSPNORM',0,ZHOOK_HANDLE)
LLNWAVE=.FALSE.
ALLOCATE(ZMETDER(NSPECG))
ALLOCATE(ZMETKE (NSPECG))
IF (LELAM) THEN
  CALL SUEMETRIC(ISMAX,ZMET,ZMETDER,ZMETKE)
ELSE
  CALL SUMETRIC(ISMAX,ZMET,ZMETDER,ZMETKE)
ENDIF
DEALLOCATE(ZMETDER)
DEALLOCATE(ZMETKE)
ALLOCATE(ZSMAG(KFLDG,0:ISMAX))

!*    2. COMPUTE SPECTRAL NORMS
!        ----------------------

CALL SPNORMBL(PSPEC,ZSNAL,ZSMAL,KFLDLOC,ZMET,KFLDLOC,KFLDLOC,LLNWAVE)
CALL COMMSPNORM1(KFLDLOC,KFLDG,ZSMAL,ZSMAG,ISMAX,KOUTPROC,KSETV,KLOC)
IF (MYPROC == KOUTPROC) THEN
  LLKE=.FALSE.
  CALL SPNORMAVE(ISMAX,ZSMAG,KFLDG,KFLDG,LLKE,PAVEG,ZAVE)
ELSE
  ! so that PAVEG is never Nan - not to cause trouble in wrsfp
  PAVEG(:)=HUGE(ZDUM)
ENDIF

DEALLOCATE(ZSMAG)

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