SUBROUTINE POAERO(PZ,PT,PUW,PVW,PTROP,PTROT,PUJET,PVJET,PJET,&
 & PNIVP,KDIM,KBEGIN,KEND,KMX,KPOL2)  

!**** *POAERO*  - POST-PROCESSING FOR AERONAUTICS

!     PURPOSE.
!     --------
!        To post-process jet and ICAO tropopause

!**   INTERFACE.
!     ----------
!       *CALL* *POAERO*

!        EXPLICIT ARGUMENTS
!        --------------------
!               INPUT :
!               ------
!         PZ     : geopotential  on model levels
!         PT     : temperature on model levels
!         PUW    : west/east component of the wind on model levels
!         PVW    : south/north component of the wind on model levels
!         PNIVP  : pressure fields at model levels
!         KDIM   : number of points on a given level
!         KBEGIN : number of the point where calculations are beginning
!         KEND   : number of the points where calculations are ending
!         KMX    : number of levels in a vertical column
!         KPOL2  : interpolation for the wind, from 1 to 5

!               OUTPUT :
!               ------
!         PTROP : level of the tropopause in Pa
!         PTROT : temperature of the tropopause
!         PUJET : 1st compobnent of the mawimum wind
!         PVJET : 2nd component of the maximum wind
!         PJET  : level of the mawimum wind in Pa

!        IMPLICIT ARGUMENTS
!        --------------------

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

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

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------
!        F. Autones and V. Martin *METEO-FRANCE*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-03-01
!        Modified : 93-01-01 J.-Marie Carriere
!        Modified : 94-11-01 X. RAGOT, R. El Khatib (adaptation to ARPEGE/IFS)
!        Mofified : 96-01-11 F.Autones (simplification tropopause (WMO only), 
!                    min value 15m/s for jet, tests after jet interpolations,
!                    no subroutine TJINT, TJFLHPA )
!        Modified : ??-??-?? J.Latour ?? tidied up by M.Hamrud
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

!      Values currently admitted :
!      KPOL2, ICRIT =
!        4,     2

!  ICRIT  = tropopause detection criteria

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

USE YOMCST   , ONLY : RG

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMX 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZ(KDIM,KMX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KDIM,KMX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUW(KDIM,KMX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVW(KDIM,KMX) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTROP(KDIM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTROT(KDIM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUJET(KDIM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVJET(KDIM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PJET(KDIM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNIVP(KDIM,KMX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBEGIN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KPOL2 
REAL(KIND=JPRB) :: PPDIFF
REAL(KIND=JPRB) :: PPEPS
REAL(KIND=JPRB) :: PPJET_SEUIL
REAL(KIND=JPRB) :: PPTROP_SEUIL
REAL(KIND=JPRB) :: PPZDMIN
REAL(KIND=JPRB) :: PPZMIN
REAL(KIND=JPRB) :: PPZN_ECART
REAL(KIND=JPRB) :: PPZPPLSQ_SEUIL

PARAMETER(PPZDMIN=2000._JPRB,PPZMIN=5000._JPRB,PPZN_ECART=1500._JPRB,&
 & PPTROP_SEUIL=100._JPRB, PPDIFF=100._JPRB,PPJET_SEUIL=15._JPRB,&
 & PPZPPLSQ_SEUIL=850._JPRB, PPEPS=1e-12_JPRB)  

REAL(KIND=JPRB) :: ZNIV(KMX),ZG(KMX),ZTP(KMX)
REAL(KIND=JPRB) :: ZGG(KMX),ZD(KMX),ZPOI1(4),ZPOI2(4),ZCF(3)
REAL(KIND=JPRB) :: ZFF(KMX),ZFFMAX(KMX)
REAL(KIND=JPRB) ::ZXX(4),ZYY(4)

REAL(KIND=JPRB) :: ZRGINV
INTEGER(KIND=JPIM) :: INIVMAX(KMX)
INTEGER(KIND=JPIM) :: IPN

INTEGER(KIND=JPIM) :: ICRIT, IJ, IKAOS, IKK, IN, INDI, INIV0, INIV1,&
 & INIV2, INIV3, INIV4, J, JK, JNIV  

REAL(KIND=JPRB) :: ZCRIT, ZCU, ZCV, ZD2, ZF, ZF1, ZF2, ZF3,&
 & ZF4, ZFMAXJ, ZG2, ZP, ZP1, ZP2, ZP3, ZP4, &
 & ZPPLSQ, ZPPLSQ2, ZPTRO50, ZVAR  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "tjcubi.intfb.h"
#include "tjquaa.intfb.h"
#include "tjqud.intfb.h"

!*****************************************************************
!         THE FIRST PART OF THIS PROGRAM DETECTS THE TROPOPAUSE
!         LEVEL AS WELL AS ITS TEMPERATURE
!*****************************************************************

!                CONVERSION OF THE ARGUMENTS WHICH ARE
!                TRANSMISTTED TO THE PROGRAMME AS REAL VALUES
!               -------------------------------------------
!               KPOL2= INTERPOLATION type FOR THE WINDS
!                      1 QUADRATIC ,2 ET 3 CUBIC, 4 ADJUSTED QUADRATIC,
!                      5 AS BEFORE BUT WEIGHTED
!               ICRIT= TROPOPAUSE DETECTION CRITERION (BY DEFAULT, WMO CRITERION
!                           -2DG/KM IF NOT SPECIFIED IN THE PROCEDURE)
!               ISCHU= additional smoothing of the results
!                      (see subroutine TJFILT. 0 by default)

!  New Operational version:    ICRIT,KPOL2
!  -----------------------  =    2  ,  3

IF (LHOOK) CALL DR_HOOK('POAERO',0,ZHOOK_HANDLE)
KPOL2=3
ZPOI1(1)=1.0_JPRB
ZPOI1(2)=1.0_JPRB
ZPOI1(3)=1.0_JPRB
ZPOI1(4)=1.0_JPRB
ZPOI2(1)=0.33_JPRB
ZPOI2(2)=0.33_JPRB
ZPOI2(3)=3._JPRB
ZPOI2(4)=0.33_JPRB
ICRIT=2
IPN=0
ZCRIT=ICRIT*(-1.E-3_JPRB)

!                GETTING  Z ET T FIELDS
!                CALCULATION TROPO  USING GRID POINT METHOD
!     ------------------------------------------------------
DO J=KBEGIN,KEND
!     --------------------

! 1.0 conNVERSION OF PRESSURE LEVELS, IN  HPA AND SEEKING OF THE LEVEL
!     GREATER THAN  5000 meters and at least 2000 meters above orography
!     -------------------------------------------------------------------

  ZRGINV=1.0_JPRB/RG

  DO JK=1,KMX
    ZNIV(JK)=PNIVP(J,JK)*1.E-2_JPRB
    ZG(JK)=PZ(J,JK)*ZRGINV
    ZTP(JK)=PT(J,JK)
  ENDDO

  IKAOS=1
  DO JK=1,KMX
!        IF (ZG(JK).GE.MAX(PPZMIN,ZG(KMX)+2000.)) IKAOS=JK
    IF (ZG(JK) >= PPZMIN) IKAOS=JK
  ENDDO
!                  _________________________________________________
!                  FOR EVERY GRID POINT OF THE CHOSEN GRID
!                  WE COMPUTE THE SLOPES OF THE VERTICAL TEMPERATURE PROFILE
!                  ZGG(JK)
!                  WE DETECT THEN THE TROPOPAUSE LEVEL
!                  CORRESPONDING TO THE WMO CRITERION (ZCRIT), LET BE  IN
!                  -----------------------------------------------------

  DO JK=KMX,2,-1
    ZD(JK)=ZG(JK-1)-ZG(JK)
    ZGG(JK)=(ZTP(JK-1)-ZTP(JK))/ZD(JK)
  ENDDO

  ZGG(1)=ZGG(2)
  ZD(1)=ZD(2)

!               DETECTION OF THE FIRST LEVEL FROM WHICH THE SLOPE BECOMES
!               GREATER THAN ZCRIT (-2DG/KM) BEGINNING FROM IKAOS
!               --------------------------------------------------------

  IN=IKAOS
  IKK=0

  IF (IKAOS >= 3) THEN
!DIR$ NOVECTOR

    DO JK=IKAOS,2,-1

      IF(IKK == 0) THEN
        IF (ZGG(JK) >= ZCRIT) THEN
          IJ=JK-1
          9999 continue
          if(zg(IJ)-zg(JK) < PPZDMIN.and.IJ >= 2)then
            IJ=IJ-1
            goto 9999
          endif
          ZD2=ZG(IJ)-ZG(JK)
          ZG2=(ZTP(IJ)-ZTP(JK))/ZD2
          IF(ZG2 >= ZCRIT) THEN
            IN=JK
            IKK=1
          ENDIF

        ENDIF
      ENDIF

    ENDDO

!DIR$ VECTOR
    IF(IKK == 0) IN=2

  ELSE
    IN=2
  ENDIF

  PTROP(J)=ZNIV(IN)
  PTROT(J)=ZTP(IN)

!***********
!  THE SECOND PART OF THE PROGRAM DETECTS AT EVERY POINT OF THE AREA
!  CONSIDERED THE MAXIMUM WIND AND GIVES ITS LEVEL AND ITS DIRECTION
!  THE PARAMET KPOL2 DEFINES THE CHOSEN INTERPOLATION TYPE.
!  WE DO NOT TAKE INTO ACCOUNT THE STRATOSPHERIC JETS.
!  IN ORDER TO DO THAT, WE ONLY KEEP AS MAXIMUM WINDS THE ONES  LOCATED
!  BELOW 5000 FEET FROM THE TROPOPAUSE LEVEL
!***********

!***********
!  BE CAREFUL WHEN CHANGING THE MODEL LEVELS
!**********

!***********
!  WE PROCEED FROM ONE POINT TO THE OTHER ONE BY STUDYING THE WIND SPEED
!  AT ALL THE LEVELS FROM THE HIGHEST ONE (50 HPA).
!***********
!     --------------------
!     --------------------

  ZPTRO50=MAX((PPTROP_SEUIL + PTROP(J)),ZNIV(3))
  ZFMAXJ=0.0_JPRB
  PJET(J)=0.0_JPRB
  PUJET(J)=0.0_JPRB
  PVJET(J)=0.0_JPRB
  INDI=1
  ZFFMAX(INDI)=0.0_JPRB
  INIVMAX(INDI)=0

!***********
!   SEEKING FOR THE LEVEL INIVMAX FO WHICH THE WIND SPEED IS THE FASTEST.
!   IF 2 LEVELS HAVE WINDS WITH THE SAME SPEED, WE CHOOSE THE LOWEST.
!   IF A LEVEL IS GREATER THAN 100 HPA WITH RESPECT TO THE TROPOPAUSE LEVEL
!   AT THE GIVEN POINT WE DO NOT TAKE IT INTO ACCOUNT ( STRATOSPHERIC JET).
!***********

  DO JNIV=1,KMX
    ZNIV(JNIV)=PNIVP(J,JNIV)*1.0E-2_JPRB
    ZFF(JNIV)=SQRT(PUW(J,JNIV)**2+PVW(J,JNIV)**2)
  ENDDO
  DO JNIV=1,KMX

    IF(ZFF(JNIV) > ZFFMAX(INDI)) THEN
      IF(ZNIV(JNIV) >= ZPTRO50)THEN
        ZFFMAX(INDI)=ZFF(JNIV)
        INIVMAX(INDI)=JNIV
      ENDIF
    ELSE
      IF(ABS(ZFF(JNIV)-ZFFMAX(INDI)) < PPEPS) THEN
        INDI=INDI+1
        ZFFMAX(INDI)=ZFF(JNIV)
        INIVMAX(INDI)=JNIV
      ENDIF
    ENDIF

  ENDDO

  if(ZFFMAX(INDI) >= PPJET_SEUIL.and.&
     & ZG(max(inivmax(indi),1)) >= ZG(KMX)+2000._JPRB) then  

    if(INIVMAX(INDI) <= 2.OR.INIVMAX(INDI) >= (KMX-1)) then
      ZFMAXJ=ZFFMAX(INDI)
      PJET(J)=ZNIV(INIVMAX(INDI))
    else
      INIV0=INIVMAX(INDI)-2
      INIV1=INIVMAX(INDI)-1
      INIV2=INIVMAX(INDI)
      INIV3=INIVMAX(INDI)+1
      INIV4=INIVMAX(INDI)+2

!***********
!  DEPENDING ON THE VALUE OF KPOL2 WE APPLY ONE OF THE INTERPOLATIONS.
!**********

      IF(KPOL2 == 1) THEN

!**********
!  QUADRATIC INTERPOLATION
!**********

        CALL TJQUD(ZNIV(INIV1),ZFF(INIV1),ZNIV(INIV2),ZFF(INIV2),&
         & ZNIV(INIV3),ZFF(INIV3),ZP,ZF,0.0_JPRB,PPEPS)  

        IF(ZP > ZNIV(INIV3).OR.ZP < ZNIV(INIV1).OR.&
           & ZF < ZFF(INIV2).OR.ZF > (1.5_JPRB*ZFF(INIV2))) THEN  
          ZFMAXJ=ZFFMAX(INDI)
          PJET(J)=ZNIV(INIVMAX(INDI))
        ELSE
          ZFMAXJ=ZF
          PJET(J)=ZP
        ENDIF

      ENDIF

      IF(KPOL2 == 2) THEN

!***********
!  CUBIC INTERPOLATION TAKING 2 LEVELS ABOVE AND 1 BELOW
!  THE LAST ENCOUNTERED LEVEL (THE LOWEST ONE):
!***********

        CALL TJCUBI(ZNIV(INIV0),ZFF(INIV0),ZNIV(INIV1),ZFF(INIV1),&
         & ZNIV(INIV2),ZFF(INIV2),ZNIV(INIV3),ZFF(INIV3),&
         & ZP1,ZF1,ZP2,ZF2,0.0_JPRB,PPEPS)  

!  CHOICE OF THE RIGHT SOLUTION BETWEEN (ZP1,ZF1)ET (ZP2,ZF2)
!  -----------------------------------------------------------
        ZFMAXJ=ZF1
        PJET(J)=ZP1

        if(ZF1 < ZFF(INIV2).OR.ABS(ZP1-ZNIV(INIV2)) > PPDIFF) then
          if(ABS(ZP2-ZNIV(INIV2)) <= PPDIFF.AND.ZF2 >= ZFF(INIV2)) then
            ZFMAXJ=ZF2
            PJET(J)=ZP2
          endif
        endif

        IF(PJET(J) > ZNIV(INIV3).OR.&
           & PJET(J) < ZNIV(INIV0).OR.&
           & ZFMAXJ < ZFFMAX(INDI).OR.&
           & ZFMAXJ > (1.5_JPRB*ZFFMAX(INDI))) THEN  
          ZFMAXJ=ZFFMAX(INDI)
          PJET(J)=ZNIV(INIVMAX(INDI))
        ENDIF

      ENDIF

      IF(KPOL2 == 3) THEN

!***********
!  CUBIC INTERPOLATION USING 1 LEVEL ABOVE ET 2 BELOW
!  THE LAST ENCOUNTERED MAXIMUM (OR THE UNIQUE MAX SI IND(J)=1)
!**********

        CALL TJCUBI(ZNIV(INIV1),ZFF(INIV1),ZNIV(INIV2),ZFF(INIV2),&
         & ZNIV(INIV3),ZFF(INIV3),ZNIV(INIV4),ZFF(INIV4),&
         & ZP3,ZF3,ZP4,ZF4,0.0_JPRB,PPEPS)  

        ZFMAXJ=ZF3
        PJET(J)=ZP3
        if(ZF3 < ZFF(INIV2).OR.ABS(ZP3-ZNIV(INIV2)) > PPDIFF) then
          if(ABS(ZP4-ZNIV(INIV2)) <= PPDIFF.AND.ZF4 >= ZFF(INIV2)) then
            ZFMAXJ=ZF4
            PJET(J)=ZP4
          endif
        endif

        IF(PJET(J) > ZNIV(INIV3).OR.&
           & PJET(J) < ZNIV(INIV0).OR.&
           & ZFMAXJ < ZFFMAX(INDI).OR.&
           & ZFMAXJ > (1.5_JPRB*ZFFMAX(INDI))) THEN  
          ZFMAXJ=ZFFMAX(INDI)
          PJET(J)=ZNIV(INIVMAX(INDI))
        ENDIF

      ENDIF

      IF(KPOL2 == 4) THEN

!*******
!   QUADRATIC INTERPOLATION WITH AN ADJUSTMENT OVER 4 POINTS
!   BY MINIMIZATION OF A DISTANCE IN THE LAST SQUARES SENSE.
!***********

        ZYY(1)=ZFF(INIV0)
        ZYY(2)=ZFF(INIV1)
        ZYY(3)=ZFF(INIV2)
        ZYY(4)=ZFF(INIV3)
        ZXX(1)=ZNIV(INIV0)
        ZXX(2)=ZNIV(INIV1)
        ZXX(3)=ZNIV(INIV2)
        ZXX(4)=ZNIV(INIV3)

        CALL TJQUAA(ZXX,ZYY,4,ZPOI1,ZCF,ZVAR,PPEPS)

        IF(ABS(ZCF(3)) >= PPEPS) THEN
          ZPPLSQ=-ZCF(2)/(2*ZCF(3))
          ZFMAXJ=ZCF(3)*ZPPLSQ**2+ZCF(2)*ZPPLSQ+ZCF(1)
        ELSE
          ZPPLSQ=ZNIV(INIVMAX(INDI))
          ZFMAXJ=ZFF(INIVMAX(INDI))
        ENDIF

        if(ZPPLSQ > ZNIV(INIV3).OR.&
           & ZPPLSQ < ZNIV(INIV1).OR.&
           & ZFMAXJ < ZFF(INIV2).OR.&
           & ZFMAXJ > (1.5_JPRB*ZFF(INIV2))) then  
          ZFMAXJ=ZFF(INIVMAX(INDI))
          PJET(J)=ZNIV(INIVMAX(INDI))
        else
          PJET(J)=ZPPLSQ
        endif

      ENDIF

      IF(KPOL2 == 5) THEN

!***********
!   AS BEFORE BUT GIVING A MORE IMPORTANT WEIGHT TO THE OBSERVED MAX
!**********

        ZYY(1)=ZFF(INIV0)
        ZYY(2)=ZFF(INIV1)
        ZYY(3)=ZFF(INIV2)
        ZYY(4)=ZFF(INIV3)
        ZXX(1)=ZNIV(INIV0)
        ZXX(2)=ZNIV(INIV1)
        ZXX(3)=ZNIV(INIV2)
        ZXX(4)=ZNIV(INIV3)

        CALL TJQUAA(ZXX,ZYY,4,ZPOI2,ZCF,ZVAR,PPEPS)

        IF(ABS(ZCF(3)) >= PPEPS) THEN
          ZPPLSQ2=-ZCF(2)/(2*ZCF(3))
          ZFMAXJ=ZCF(3)*ZPPLSQ2**2+ZCF(2)*ZPPLSQ2+ZCF(1)
        ELSE
          ZPPLSQ2=ZNIV(INIV2)
          ZFMAXJ=ZYY(2)
        ENDIF

        if(ZPPLSQ2 > ZNIV(INIV3).OR.&
           & ZPPLSQ2 < ZNIV(INIV1).OR.&
           & ZFMAXJ < ZFF(INIV2).OR.&
           & ZFMAXJ > (1.5_JPRB*ZFF(INIV2))) then  
          ZFMAXJ=ZFF(INIVMAX(INDI))
          PJET(J)=ZNIV(INIVMAX(INDI))
        else
          PJET(J)=ZPPLSQ2
        endif

      ENDIF

! *************
    endif

!***********
!  WE TRANSFORM THE RESULTS INTO ZONAL AND MERIDIONAL COMPONENTS
!  BY CONSIDERING THAT THE DIRECTION IS THE ONE OF THE LEVEL INIV2.
!***********

    INIV2=INIVMAX(INDI)

    ZCU=PUW(J,INIV2)/SQRT(PUW(J,INIV2)**2+PVW(J,INIV2)**2)
    ZCV=PVW(J,INIV2)/SQRT(PUW(J,INIV2)**2+PVW(J,INIV2)**2)
    PUJET(J)=ZFMAXJ*ZCU
    PVJET(J)=ZFMAXJ*ZCV
  ELSE
    PUJET(J)=0.0_JPRB
    PVJET(J)=0.0_JPRB
    PJET(J)=0.0_JPRB
  ENDIF

  PTROP(J)=100._JPRB*PTROP(J)
  PJET(J)=100._JPRB*PJET(J)

ENDDO

IF (LHOOK) CALL DR_HOOK('POAERO',1,ZHOOK_HANDLE)

END SUBROUTINE POAERO
