specnorm.F90 Source File

! (C) Copyright 2000- ECMWF.
! (C) Copyright 2000- Meteo-France.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!


SUBROUTINE SPECNORM(PNORM,PSPEC,KVSET,KMASTER,KRESOL,PMET)
!**** *SPECNORM* - Compute global spectral norms

!     Purpose.
!     --------
!        Interface routine for computing spectral norms

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

!     Explicit arguments : All arguments optional
!     --------------------
!     PSPEC(:,:)  - Spectral array
!     KVSET(:)    - "B-Set" for each field
!     KMASTER     - processor to recieve norms
!     KRESOL      - resolution tag  which is required ,default is the
!                   first defined resulution (input)
!     PMET(:)     - metric
!     PNORM(:)    - Norms (output for processor KMASTER)
!
!     Method.
!     -------

!     Externals.  SET_RESOL - set resolution
!     ----------  SPNORM_CTL - control routine

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

!     Modifications.
!     --------------
!        Original : 00-03-03

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB

!ifndef INTERFACE

USE TPM_GEN         ,ONLY : NERR
USE TPM_DISTR       ,ONLY : D, NPRTRV, MYSETV, MYPROC

USE SET_RESOL_MOD   ,ONLY : SET_RESOL
USE SPNORM_CTL_MOD  ,ONLY : SPNORM_CTL
USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS

!endif INTERFACE

IMPLICIT NONE

! Declaration of arguments


REAL(KIND=JPRB)             , INTENT(OUT) :: PNORM(:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(IN)  :: PSPEC(:,:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KVSET(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KMASTER
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(IN)  :: PMET(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KRESOL
!ifndef INTERFACE

INTEGER(KIND=JPIM) :: IMASTER,IFLD,IFLD_G,J

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

! Set current resolution
CALL SET_RESOL(KRESOL)

! Set defaults
IMASTER = 1
IFLD    = 0


IF(PRESENT(KMASTER)) THEN
  IMASTER = KMASTER
ENDIF

IF(PRESENT(KVSET)) THEN
  IFLD_G = UBOUND(KVSET,1)
  DO J=1,IFLD_G
    IF(KVSET(J) > NPRTRV) THEN
      WRITE(NERR,*) 'SPECNORM:KVSET(J) > NPRTRV ',J,KVSET(J),NPRTRV
      CALL ABORT_TRANS('SPECNORM:KVSET TOO LONG OR CONTAINS VALUES OUTSIDE RANGE')
    ENDIF
    IF(KVSET(J) == MYSETV) THEN
      IFLD = IFLD+1
    ENDIF
  ENDDO
ELSE
  IF(PRESENT(PSPEC)) THEN
    IFLD = UBOUND(PSPEC,1)
  ENDIF
  IFLD_G = IFLD
ENDIF

IF(NPRTRV >1) THEN
  IF(IFLD > 0 .AND. .NOT. PRESENT(KVSET)) THEN
    WRITE(NERR,*)'NPRTRV >1 AND IFLD > 0 AND NOT PRESENT(KVSET)',&
                 &NPRTRV,IFLD
    CALL ABORT_TRANS('SPECNORM: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!')
  ENDIF
ENDIF
IF(MYPROC == IMASTER) THEN
  IF(UBOUND(PNORM,1) < IFLD_G) THEN
    CALL ABORT_TRANS('SPECNORM: PNORM TOO SMALL')
  ENDIF
ENDIF
IF(IFLD > 0 ) THEN
  IF(.NOT. PRESENT(PSPEC)) THEN
    CALL ABORT_TRANS('SPECNORM: PSPEC NOT PRESENT')
  ENDIF
  IF(UBOUND(PSPEC,1) < IFLD) THEN
    CALL ABORT_TRANS('SPECNORM: FIRST DIMENSION OF PSPEC TOO SMALL')
  ENDIF
  IF(UBOUND(PSPEC,2) < D%NSPEC2) THEN
    CALL ABORT_TRANS('SPECNORM: FIRST DIMENSION OF PSPEC TOO SMALL')
  ENDIF
ENDIF

CALL SPNORM_CTL(PNORM,PSPEC,IFLD,IFLD_G,KVSET,IMASTER,PMET)

!endif INTERFACE

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

END SUBROUTINE SPECNORM