SUBROUTINE PREINTTL(KDLEN,KLEN,KSET,&
 & PRESH,PRESF,PGEOPH,PGEOPF,&
 & PXP,PXPD,PXZ,PXZD,PCP,PRF,PKAP,&
 & PUF,PVF,PTF,PQF,PO3F,PCLWF,PCIWF,PCCF,&
 & PTSTAR,PT0,&
 & PDELP,PRDELP,PLNPR,PALPH,PRTGR,&
 & PRPRE,PRPP,&
 & PRESH5,PRESF5,&
 & PXP5,PXZ5,PCP5,PRF5,PTF5,&
 & PDELP5,PRDELP5,PLNPR5,PALPH5,&
 & PRPRE5,PRPP5,YDGEMSPROF)  

!****  PREINTTL  - PREPARATION OF VERTICAL INTERPOLATION, TANGENT LINEAR

!     PREINT    D. VASILJEVIC           02/01/91       ECMWF
!     PREINTTL  M. FISHER               10/06/94       ECMWF

!     PURPOSE
!     -------

!        PREINTTL PREPARES INTERPOLATION FOR ONE SET OF OBSERVATIONS.

!**   INTERFACE
!     ---------

!     SUBROUTINE PREINTTL (KDLEN,..)

!        WHERE KDLEN   = FIRST DIMENSION (OBSERVATIONS)
!              KLEN    = ACTUAL NUMBER OF OBSERVATIONS
!              KSET    = NUMBER (NUMERO) OF THE OBS SET TO BE TREATED
!              POROG   = OROGRAPHY AT OBS. PONTS
!              PRESH   = HALF LEVEL PRESS. AT OBS. POINTS
!              PRESF   = FULL LEVEL PRESS. AT OBS. POINTS
!              PGEOPH  = HALF LEVEL GEOP. AT OBS. POINTS
!              PGEOPF  = FULL LEVEL GEOP. AT OBS. POINTS
!              PXP     = INTERMEDIATE ARRAY (FOR INTERPOLATION IN P)
!              PXPD    = ...........................................
!              PXZ     = INTERMEDIATE ARRAY (FOR INTERPOLATION IN Z)
!              PXZD    = ...........................................
!              PCP     = Cp
!              PRF     = R
!              PKAP    = Kappa
!              PUF     = U VALUES (MODEL) AT OB. POINS
!              PVF     = V VALUES (MODEL) AT OB. POINS
!              PTF     = T VALUES (MODEL) AT OB. POINS
!              PQF     = Q VALUES (MODEL) AT OB. POINS
!              PO3F    = O3 VALUES (MODEL) AT OB. POINS
!              PCLWF   = CLW VALUES (MODEL) AT OB. POINS
!              PCIWF   = CIW VALUES (MODEL) AT OB. POINS
!              PCCF    = CC VALUES (MODEL) AT OB. POINS
!              PTSTAR  = T*
!              PT0     = T0
!              PDELP   = PRESSURE DIFF. ACROSS LAYERS
!              PRDELP  = INVERSE OF THE ABOVE
!              PLNPR   = LOG. OF THE RATIO OF PRESSURE
!              PALPH   = COEFFICIENTS OF THE HYDROSTATICS
!              PRTGR   = FOR PRESS. GRAD. TERM AND ENE. CONV.
!              PRPRE   = INVERSE OF PRESSURE
!              PRPP    = INVERSE OF P(j)*P(j+1)
!              YDGEMSPROF    = GEMS PROFILES (OPTIONAL)

!        PREINTTL IS CALLED FROM HOPTL

!**   METHOD
!     ------

!**   EXTERNALS
!     ---------

!        GPPREHTL - COMPUTES HALF LEVEL PRESSURES
!        GPPREFTL - COMPUTES FULL LEVEL PRESSURES
!        PPINITTL - SET-UP AUX. ARRAYS FOR VERTICAL INTERPOLATION
!        GPXYBTL  - COMPUTES AUXILLARY ARRAYS
!        CTSTARTL - COMPUTES STANDARD SURFACE TEMPERATURE AND SURFACE
!                   TEMPERATURE
!        GPRCPTL  -
!        GPGEOTL  -
!        PPINITZTL - SET-UP AUX. ARRAYS FOR VERTICAL INTERPOLATION

!**   MODIFICATIONS
!     -------------
!     E.Andersson 92-06-22 : Introduce SATEM
!     L. Isaksen  96-02-20 : NFLEV --> NFLEVG
!     E.Andersson 96-02-07 : Introduce SCATT
!     E.Andersson 97-11-14 : GOM-variables more flexible
!     E.Andersson 99-07-02 : Incorporate clouds
!     R. El Khatib : 01-08-07 Pruning options
!     S. Healy    04-10-22 : Switch off surface pressure for NRARAD (gps)
!     N. Bormann  04-12-23 : RARAD becomes LIMB
!     M.Hamrud    15-Jan-2006  Revised GPRCP
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG   ,NPPM
USE YOMSTA   , ONLY : NLEXTRAP
USE YOMGEM   , ONLY : VBH      ,VC       ,VDELB
USE GOMS_MIX     , ONLY : YGOMUA,YGOMS
USE YOMOBSET , ONLY : MTYPOB
USE YOMDB
USE YOM_YGFL , ONLY : NGHG, YGHG, NGRG, YGRG, NAERO, YAERO 
USE TYPE_GEMS_PROFILES

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSET 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRESH(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRESF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGEOPH(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGEOPF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXP(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXPD(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXZ(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXZD(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCP(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PKAP(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PO3F(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLWF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCIWF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCCF(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTSTAR(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PT0(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDELP(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRDELP(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLNPR(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PALPH(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRTGR(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRPRE(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRPP(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXP5(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXZ5(KDLEN,0:NFLEVG,NPPM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCP5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRDELP5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPRE5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPP5(KDLEN,NFLEVG) 

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

INTEGER(KIND=JPIM) :: IOBSTYPE,IPOSM,ISET,ILEN,JOBS,JLEV,JGHG,JGRG,JAERO
INTEGER(KIND=JPIM) :: IGEMS,ISTGHG,IENGHG,ISTGRG,IENGRG,ISTAERO,IENAERO
INTEGER(KIND=JPIM) :: IGHG,IGRG,IAERO
REAL(KIND=JPRB) :: ZHOOK_HANDLE

TYPE (TYPE_GEMSPROF), OPTIONAL   ,INTENT(OUT) :: YDGEMSPROF(KDLEN,NGEMS)

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

#include "ctstartl.intfb.h"
#include "gpgeotl.intfb.h"
#include "gppreftl.intfb.h"
#include "gpprehtl.intfb.h"
#include "gprcptl.intfb.h"
#include "gpxybtl.intfb.h"
#include "ppinittl.intfb.h"
#include "ppinitztl.intfb.h"

#include "openmp_obs.h"

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

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

!     ------------------------------------------------------------------
!*       1.       PREPARATION OF INTERPOLATION
!                 ----------------------------

ISET=ABS(KSET)
ILEN     = KLEN
IOBSTYPE = MOD(MTYPOB(ISET),100)

!   KSET < 0 INDICATES THAT MODEL DATA HAVE ALREADY BEEN FILLED
IF(KSET < 0) GOTO 120

!*          1.1   FIND OUT RELEVANT ARRAYS FOR EACH OBSERVATION

DO JOBS = 1,ILEN
  IPOSM  = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)

!*          1.1.2 SURFACE PRESSURE

  PRESH(JOBS,NFLEVG) = YGOMS(IPOSM)%SP
  PRESH(JOBS,NFLEVG)=PRESH5(JOBS,NFLEVG)*PRESH(JOBS,NFLEVG)

ENDDO

DO JOBS = 1,ILEN
  IPOSM  = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)

  IF(PRESENT(YDGEMSPROF)) THEN
    DO IGEMS=1,NGEMS
      YDGEMSPROF(JOBS,IGEMS)%MODELPROF(:)=0.0_JPRB
      YDGEMSPROF(JOBS,IGEMS)%RTTOVPROF(:)=0.0_JPRB
      YDGEMSPROF(JOBS,IGEMS)%IGRIB=0
      YDGEMSPROF(JOBS,IGEMS)%CSPECIES='XXX'
      YDGEMSPROF(JOBS,IGEMS)%LRTTOV=.FALSE.
    ENDDO
  ENDIF

!*          1.1.3 FILL OUT THE AD HOC ARRAYS WITH THE MODEL VALUES FOR
!                 U, V, T, Q AND OZON
  IF(YGOMUA(IPOSM)%LU) THEN
    PUF(JOBS,1:NFLEVG) = YGOMUA(IPOSM)%U(:)
  ELSE
    PUF(JOBS,1:NFLEVG) = YGOMS(IPOSM)%UL
  ENDIF
  IF(YGOMUA(IPOSM)%LV) THEN
    PVF(JOBS,1:NFLEVG) = YGOMUA(IPOSM)%V(:)
  ELSE
    PVF(JOBS,1:NFLEVG) = YGOMS(IPOSM)%VL
  ENDIF
  IF(YGOMUA(IPOSM)%LT) THEN
    PTF(JOBS,1:NFLEVG) = YGOMUA(IPOSM)%T(:)
  ELSE
    PTF(JOBS,1:NFLEVG) = YGOMS(IPOSM)%TL
  ENDIF
  IF(YGOMUA(IPOSM)%LQ) THEN
    PQF(JOBS,1:NFLEVG) = YGOMUA(IPOSM)%Q(:)
  ELSE
    PQF(JOBS,1:NFLEVG) = YGOMS(IPOSM)%QL
  ENDIF
  IF(YGOMUA(IPOSM)%LO3) THEN
    PO3F(JOBS,1:NFLEVG) = YGOMUA(IPOSM)%O3(:)
  ELSE
    PO3F(JOBS,1:NFLEVG) = 0.0_JPRB
  ENDIF
  IF(YGOMUA(IPOSM)%LCLW) THEN
    PCLWF(JOBS,1:NFLEVG) = YGOMUA(IPOSM)%CLW(:)
  ELSE
    PCLWF(JOBS,1:NFLEVG) = 0.0_JPRB
  ENDIF
  IF(YGOMUA(IPOSM)%LCIW) THEN
    PCIWF(JOBS,1:NFLEVG) = YGOMUA(IPOSM)%CIW(:)
  ELSE
    PCIWF(JOBS,1:NFLEVG) = 0.0_JPRB
  ENDIF
  IF(YGOMUA(IPOSM)%LCC) THEN
    PCCF(JOBS,1:NFLEVG) = YGOMUA(IPOSM)%CC(:)
  ELSE
    PCCF(JOBS,1:NFLEVG) = 0.0_JPRB
  ENDIF
!rje
  IF(PRESENT(YDGEMSPROF)) THEN
    IGEMS=0
    IGHG=0
    DO JGHG=1,NGHG
      IF(YGOMUA(IPOSM)%LGHG(JGHG)) THEN
        IGEMS=IGEMS+1
        ISTGHG = 1+IGHG*NFLEVG
        IENGHG = ISTGHG+NFLEVG-1
        YDGEMSPROF(JOBS,IGEMS)%MODELPROF(1:NFLEVG) = YGOMUA(IPOSM)%GHG(ISTGHG:IENGHG)
        YDGEMSPROF(JOBS,IGEMS)%IGRIB = YGHG(JGHG)%IGRBCODE
        YDGEMSPROF(JOBS,IGEMS)%CSPECIES = 'GHG'
        YDGEMSPROF(JOBS,IGEMS)%LRTTOV = .TRUE.
        IGHG=IGHG+1
      ENDIF
    ENDDO
    IGRG=0
    DO JGRG=1,NGRG
      IF(YGOMUA(IPOSM)%LGRG(JGRG)) THEN
        IGEMS=IGEMS+1
        ISTGRG = 1+IGRG*NFLEVG
        IENGRG = ISTGRG+NFLEVG-1
        YDGEMSPROF(JOBS,IGEMS)%MODELPROF(1:NFLEVG) = YGOMUA(IPOSM)%GRG(ISTGRG:IENGRG)
        YDGEMSPROF(JOBS,IGEMS)%IGRIB = YGRG(JGRG)%IGRBCODE
        YDGEMSPROF(JOBS,IGEMS)%CSPECIES = 'GRG'
        YDGEMSPROF(JOBS,IGEMS)%LRTTOV = .FALSE.
        IGRG=IGRG+1
      ENDIF
    ENDDO
    IAERO=0
    DO JAERO=1,NAERO
      IF(YGOMUA(IPOSM)%LAERO(JAERO)) THEN
        IGEMS=IGEMS+1
        ISTAERO = 1+IAERO*NFLEVG
        IENAERO = ISTAERO+NFLEVG-1
        YDGEMSPROF(JOBS,IGEMS)%MODELPROF(1:NFLEVG) = YGOMUA(IPOSM)%AERO(ISTAERO:IENAERO)
        YDGEMSPROF(JOBS,IGEMS)%IGRIB = YAERO(JAERO)%IGRBCODE
        YDGEMSPROF(JOBS,IGEMS)%CSPECIES = 'AERO'
        YDGEMSPROF(JOBS,IGEMS)%LRTTOV = .FALSE.
        IAERO=IAERO+1
      ENDIF
    ENDDO
  ENDIF
!rje

ENDDO

!*          1.2   COMPUTATION OF HALF LEVEL PRESSURES

120 CONTINUE
CALL GPPREHTL(KDLEN,1,ILEN,NFLEVG,VBH,PRESH)

!*          1.3   SOME OTHER PREPARATIONS FOR INTERPOLATION

CALL GPXYBTL (KDLEN,1,ILEN,NFLEVG,&
 & VDELB,VC,&
 & PRESH,&
 & PDELP,PRDELP,PLNPR,PALPH,PRTGR,&
 & PRPRE,PRPP,&
 & PRESH5,PDELP5,PRDELP5,PLNPR5,PRPRE5,PRPP5)  

!*          1.4   COMPUTATION OF HALF AND FULL LEVEL PRESSURES

CALL GPPREFTL (KDLEN,1,ILEN,NFLEVG,&
 & PALPH,PRESH,PRESF,&
 & PALPH5,PRESH5)

!*          1.5   COMPUTION OF THE GEOPOTENTIALS ON THE MODEL LEVELS

!*          1.5.1  PRELIMINARY COMPUTATION

CALL GPRCPTL (KDLEN,1,ILEN,NFLEVG,PQ=PQF,&
             &PCP=PCP,PR=PRF,PKAP=PKAP,PCP5=PCP5,PR5=PRF5)

!*          1.5.2  GEOP. CALCULATION

DO JLEV=0,NFLEVG
  PGEOPH(1:ILEN,JLEV)=0.0_JPRB
ENDDO

CALL GPGEOTL (KDLEN,1,ILEN,NFLEVG,&
 & PGEOPH,PGEOPF,&
 & PTF(1,1),PRF,PLNPR,PALPH,&
 & PTF5(1,1),PRF5,PLNPR5,PALPH5)  

!*          1.6   COMPUTION OF AUX. ARRAYS FOR VERTICAL INTERPOLATIONS

!*          1.6.1 VERTICAL INTERPOLATIONS IN P

CALL PPINITTL (KDLEN,1,ILEN,NFLEVG,PRESH,PRESF,PXP,PXPD,PRESH5,PRESF5,PXP5)

!*          1.6.2 VERTICAL INTERPOLATIONS IN Z

CALL PPINITZTL (KDLEN,1,ILEN,NFLEVG,&
 & PGEOPH,PGEOPF,&
 & PXZ,PXZD,&
 & PXZ5)  

!*          1.7   COMPUTE T* AND T0

CALL CTSTARTL (KDLEN,1,ILEN,&
 & PTF(1,NLEXTRAP),PRESH(1,NFLEVG),PRESF(1,NLEXTRAP),&
 & PTSTAR,PT0,&
 & PTF5(1,NLEXTRAP),PRESH5(1,NFLEVG),&
 & PRESF5(1,NLEXTRAP))  

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('PREINTTL',1,ZHOOK_HANDLE)
END SUBROUTINE PREINTTL
