SUBROUTINE PREINTS(KDLEN,KLEN,KSET,&
 & PRESH5,&
 & PUF5,PVF5,PTF5,PQF5,PQN5,&
 & PTS5,PSST5,PU05,PV05,PU10N5,PV10N5,PCHN5,&
 & PRF5,&
 & PWS5,PVEG5,PCI5,PWL5,&
 & PSN5,PSLM5,PZ05,&
 & PES5,PCPTGZ5,PWET5,PQS5,PCPTS5,PAPHI5,&
 & PRI5,PBN5,PBM5,PBH5,&
 & PLNPR5,PALPH5,PTCLS5,PHUCLS5)  

!****  PREINTS  - PREPARATION FOR THE SURFACE INTERPOLATION

!     CARLA CARDINALI         18/03/92       ECMWF

!     PURPOSE
!     -------

!        PREINT PREPARES INTERPOLATION FOR ONE SET OF
!        SYNOP OBSERVATIONS.

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

!        CALL PREINTS(KDLEN,KLEN,KSET,
!       1             PRESH5,
!       2             PUF5,PVF5,PTF5,PQF5,
!       3             PTS5,PSST5,PU05,PV05,PCHN5,
!       4             PRF5,
!       5             PWS5,PVEG5,PCI5,PWL5,
!       6             PSN5,PSLM5,PZ05,
!       7             PCPTGZ5,PWET5,PQS5,PCPTS5,PAPHI5,
!       8             PRI5,PBN5,PBM5,PBH5,
!       9             PLNPR5,PALPH5)

!        WHERE KDLEN   = FIRST DIMENSION (OBSERVATIONS)
!              KLEN    = ACTUAL NUMBER OF OBSERVATIONS
!              KSET    = NUMBER (NUMERO) OF THE OBS SET TO BE TREATED
!              PRESH5  = HALF LEVEL PRESS. AT OBS. POINTS
!              PUF5    = U VALUES (MODEL) AT OB. POINS
!              PVF5    = V VALUES (MODEL) AT OB. POINS
!              PTF5    = T VALUES (MODEL) AT OB. POINS
!              PQF5    = Q VALUES (MODEL) AT OB. POINS
!              PTS5    = SURFACE TEMPERATURE
!              PSST5   = SURFACE TEMPERATURE OVER SEA (duplicated obs)
!              PU05    = U-COMP OF OCEAN CURRENT
!              PV05    = V-COMP OF OCEAN CURRENT
!              PU10N5  = U-COMP OF 10M NEUTRAL WIND
!              PV10N5  = V-COMP OF 10M NEUTRAL WIND
!              PCHN5   = WAVE CHARNOCK
!              PRF5    = R
!              PWS5    = SOIL WETNESS
!              PVEG5   = VEGETATION
!              PCI5    = Sea-ice fraction
!              PWL5    = SKIN RESERVOIR
!              PSN5    = SNOW DEPTH
!              PSLM5   = SEE/LAND MASK
!              PZ05    = ROUGHNESS LENGTH
!              PCPTGZ5 = STATIC ENERGY (LOWER LEVEL)
!              PWET5   = WETNESS
!              PQS5    = SATURATION HUMIDITY
!              PCPTS5  = STATIC ENERGY AT THE SURFACE
!              PRI5    = RICHARDSON NO.
!              PBN5    = STABILITY FUNCTION (NEUTRAL)
!              PBM5    = DRAG COEFFICIENT FOR MOMENTUM
!              PBH5    = DRAG COEFFICIENT FOR HEAT
!              PLNPR5  = LOG. OF THE RATIO OF PRESSURE
!              PALPH5  = COEFFICIENTS OF THE HYDROSTATICS
!              PTCLS5    = CLS TEMPERATURE

!        PREINTS IS CALLED FROM SURFACEO

!**   METHOD
!     ------

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

!        GPRCP      - COMPUTES Cp AND R
!        GPGEO      - COMPUTES GEOPOTENTIAL AT THE MODEL LEVELS
!        ROUSEA     - CORRECTS THE ROUGHNESS LENGTS OVER SEA
!        Z0SEA      - CORRECTS THE ROUGHNESS LENGTS OVER SEA INCLUDING INFO ON WAVE CHARNOCK
!        QNEG       - PUTS NEGATIVE VALUES OF Q EQUAL TO 0
!        SURBOUND   - COMPUTES THE STATIC ENERGY
!        EXCHCO     - COMPUTES STABILITY FUNCTION

!**   MODIFICATIONS
!     -------------
!     E.Andersson 96-02-01 : Incorporating Scat in SURFACEO
!     L. Isaksen  96-02-20 : NFLEV --> NFLEVG
!     M. Fisher   96-05-16 : Fill from GSTS5, etc. if in tangent linear
!     P. MOLL     96-07-18 : ACHMT transplantation
!                            (modification of surbound and exchco)
!     E.Andersson 97-11-17 : Flexible GOM arrays. Model Z0 for SCAT.
!     E.Andersson 97-11-17 : Use model's Z0.
!     P. Moll     99-08-02 : ACHMT final transplantation
!     E. Gerard   99-05-05 : Interpolation of SATEM type obs.
!     P. Viterbo  99-09-01 : Surface tiles.
!     F.Taillefer 02-05-22 : Add array for SST
!     P. Viterbo  04-05-28 : surf library and new surface units.
!     C. Payan    05-05-10 : GOM%ECCI controlled by NUSE_ECCI key
!     K. Scipal   07-09-10 : removed nullifyng of soil moisture for NSCATT obs
!     H. Hersbach 08-07-04 : Add ocean currents and wave Charnock
!     S. Martinez 24-June-2009 workarounds for SX9 compiler (precomputation of
!               indirect addressing + replace test on optional argument in loop
!               by local logical variable - thanx to E.Sevault)
!     H. Hersbach 09-12-04 : EXCHCO_VDF; neutral wind
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVG
USE YOMOBSET , ONLY : MTYPOB
USE YOMOBS   , ONLY : LCACHMT, LVDFTRAJ
USE YOMCT0B  , ONLY : LECMWF
USE YOMCST   , ONLY : RG
USE YOMCOCTP , ONLY : NSCATT
USE YOMVRTL  , ONLY : LTLINT   ,LOBSTL
USE YOEVDF   , ONLY : NVTYPES
USE YOMDB
USE GOMS_MIX , ONLY : YGOMS,YGOMS5,YGOMEC,NUSE_ECCI
USE YOEPHY   , ONLY : LECURR

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSET 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQF5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQN5(KDLEN,0:NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT),OPTIONAL :: PTCLS5(KDLEN)
REAL(KIND=JPRB)   ,INTENT(INOUT),OPTIONAL :: PHUCLS5(KDLEN)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSST5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRF5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVEG5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCI5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWL5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSN5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSLM5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PU05(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PV05(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PU10N5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PV10N5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCHN5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PZ05(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PES5(KDLEN,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCPTGZ5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWET5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCPTS5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHI5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRI5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBN5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBM5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBH5(KDLEN) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR5(KDLEN,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH5(KDLEN,NFLEVG) 

! LOCAL VARIABLES
REAL(KIND=JPRB) ::ZAPHIH5 (KDLEN,0:NFLEVG) ! GEOPOTENTAL ON MODEL LEVELS
REAL(KIND=JPRB) ::ZUF5(KDLEN),ZVF5(KDLEN),ZH105(KDLEN)

LOGICAL :: LLPTCLS5, LLVDF5
INTEGER(KIND=JPIM) :: IOBSTYPE,IPOSM(KDLEN),ILEN,ISET,JOBS
REAL(KIND=JPRB) :: ZRTFREEZSICE,ZRVCOV(0:NVTYPES)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "surf_inq.h"
END INTERFACE

#include "exchco.intfb.h"
#include "gpgeo.intfb.h"
#include "qneg.intfb.h"
#include "rousea.intfb.h"
#include "z0sea.intfb.h"
#include "exchco_vdf.intfb.h"
#include "surbound.intfb.h"

#include "openmp_obs.h"

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

IF (LHOOK) CALL DR_HOOK('PREINTS',0,ZHOOK_HANDLE)
CALL SURF_INQ(PRTFREEZSICE=ZRTFREEZSICE,PRVCOV=ZRVCOV)

LLVDF5=.FALSE.
ISET = ABS(KSET)
ILEN = KLEN

!   KSET < 0 INDICATES THAT MODEL DATA HAVE ALREADY BEEN FILLED
IF (KSET >= 0) THEN
  IOBSTYPE = MOD(MTYPOB(ISET),100)
! Currently, limited usage to scatt data
  LLVDF5=(LVDFTRAJ.AND.(IOBSTYPE == NSCATT))


!*          1.1   FIND OUT RELEVANT ARRAYS FOR EACH OBSERVATION
!*                Some of the surface parameters are not available for
!*                SCAT data, but that doesn't matter because all SCAT 
!*                data are over sea (No snow, no soil wetness...).
!*                Sea-Z0 could be calculated by ROUSEA, below.

  LLPTCLS5 = PRESENT(PTCLS5)
  DO JOBS = 1,ILEN
    IPOSM(JOBS) = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)
  ENDDO

  DO JOBS = 1,ILEN
    IF (LTLINT .AND. LOBSTL) THEN
      PTS5 (JOBS) = YGOMS5(IPOSM(JOBS))%TS
      PU05 (JOBS) = YGOMS5(IPOSM(JOBS))%U0
      PV05 (JOBS) = YGOMS5(IPOSM(JOBS))%V0
      PCHN5(JOBS) = YGOMS5(IPOSM(JOBS))%CHN
!     PTCLS5 (JOBS) = YGOMS5(IPOSM(JOBS))%TCLS
      PZ05 (JOBS) = YGOMS5(IPOSM(JOBS))%Z0
      PWS5 (JOBS) = YGOMS5(IPOSM(JOBS))%WS
      PWL5 (JOBS) = YGOMS5(IPOSM(JOBS))%WL
      PSN5 (JOBS) = YGOMS5(IPOSM(JOBS))%SN
      PU10N5(JOBS)= YGOMS5(IPOSM(JOBS))%U10N
      PV10N5(JOBS)= YGOMS5(IPOSM(JOBS))%V10N
    ELSE
      PTS5 (JOBS) = YGOMS(IPOSM(JOBS))%TS
      PU05 (JOBS) = YGOMS(IPOSM(JOBS))%U0
      PV05 (JOBS) = YGOMS(IPOSM(JOBS))%V0
      PCHN5(JOBS) = YGOMS(IPOSM(JOBS))%CHN
      IF (LLPTCLS5) THEN
        PTCLS5 (JOBS) = YGOMS(IPOSM(JOBS))%TCLS
        PHUCLS5 (JOBS) = YGOMS(IPOSM(JOBS))%HUCLS
      ENDIF
      PZ05 (JOBS) = YGOMS(IPOSM(JOBS))%Z0
      PWS5 (JOBS) = YGOMS(IPOSM(JOBS))%WS
      PWL5 (JOBS) = YGOMS(IPOSM(JOBS))%WL
      PSN5 (JOBS) = YGOMS(IPOSM(JOBS))%SN
      PSST5(JOBS) = YGOMS(IPOSM(JOBS))%SST
      PU10N5(JOBS)= YGOMS(IPOSM(JOBS))%U10N
      PV10N5(JOBS)= YGOMS(IPOSM(JOBS))%V10N
    ENDIF
 !   IF(IOBSTYPE == NSCATT) THEN
 !     PWS5 (JOBS)=0.0_JPRB
 !     PWL5 (JOBS)=0.0_JPRB
 !     PSN5 (JOBS)=0.0_JPRB
 !   ENDIF
    IF (NUSE_ECCI == 1) THEN
       PCI5(JOBS)=YGOMEC(IPOSM(JOBS))%ECCI
    ELSE
       IF (PTS5(JOBS) < ZRTFREEZSICE) THEN
         PCI5(JOBS)=1.
       ELSE
         PCI5(JOBS)=0.
       ENDIF
    ENDIF 
    IF (LECMWF) THEN
      PZ05(JOBS)=PZ05(JOBS)/RG
!  fudge VEG, because it is only used for SURBOUND, which does not reflect
!  the ECMWF surface parameterization, anyhow. If it is needed for some
!  more serious purpose, the arrays TVL,TVH,CVL,CVH should be ouput of
!  this routine
      PVEG5(JOBS)=&
       & YGOMEC(IPOSM(JOBS))%ECCVH*ZRVCOV(NINT(YGOMEC(IPOSM(JOBS))%ECTVH))+&
       & YGOMEC(IPOSM(JOBS))%ECCVL*ZRVCOV(NINT(YGOMEC(IPOSM(JOBS))%ECTVL))  
    ELSE
      PVEG5(JOBS)=YGOMEC(IPOSM(JOBS))%ECVEGE
    ENDIF
    PSLM5(JOBS)=YGOMEC(IPOSM(JOBS))%ECLSMA
  ENDDO
ENDIF

!     ------------------------------------------------------------------
!*       2.  PREPARATION OF SURFACE ARRAYS
!            -----------------------------


! IF (.NOT.LECMWF .AND. LCACHMT) RETURN

!*          2.1   FIND OUT POST-PROCESSED GEOPOTENTIAL IN THE LOWER
!                 LEVEL MODEL

!*          2.3 COMPUTE THE GEOPOTENTIAL ON MODEL LEVELS

ZAPHIH5(1:ILEN,NFLEVG)=0.0_JPRB
CALL GPGEO(KDLEN,1,ILEN,NFLEVG,ZAPHIH5,PAPHI5,PTF5(1,1),PRF5,PLNPR5,PALPH5)

IF (.NOT.LECMWF .AND. LCACHMT .AND. LHOOK) CALL DR_HOOK('PREINTS',1,ZHOOK_HANDLE)
IF (.NOT.LECMWF .AND. LCACHMT) RETURN

!*          2.3.1 CORRECT FOR OCEAN CURRENT

 IF (LECURR) THEN
    ZUF5(1:ILEN)=PUF5(1:ILEN,NFLEVG)-PU05(1:ILEN)
    ZVF5(1:ILEN)=PVF5(1:ILEN,NFLEVG)-PV05(1:ILEN)
 ELSE
    ZUF5(1:ILEN)=PUF5(1:ILEN,NFLEVG)
    ZVF5(1:ILEN)=PVF5(1:ILEN,NFLEVG)
 ENDIF


!*          2.3.2 COMPUTE THE ROUGHNESS LENGTH OVER SEA
IF (.NOT.LECMWF) THEN
  CALL ROUSEA(KDLEN,1,ILEN,PAPHI5(1,NFLEVG),&
   & PUF5(1,NFLEVG),PVF5(1,NFLEVG),PSLM5,PZ05)  
ENDIF
IF (LLVDF5) THEN
   ZH105(1:KDLEN)=10.0_JPRB*RG
   CALL Z0SEA(KDLEN,1,ILEN,ZH105,&
    & PU10N5,PV10N5,PSLM5,PCHN5,PZ05)  
ENDIF

!*         2.4    NEW THERMODYNAMIC VARIABLE AND BOUNDARY CONDITIONS.

CALL QNEG(KDLEN,1,ILEN,PQF5(1,NFLEVG),PQN5(1,NFLEVG))
CALL SURBOUND(&
 & KDLEN,1,ILEN,&
 & PAPHI5(1,NFLEVG),PQN5(1,NFLEVG),PTF5(1,NFLEVG),&
 & PTS5,PRESH5(1,NFLEVG),&
 & PWS5,PVEG5,PWL5,&
 & PSN5,PSLM5,&
 & PES5(1,1),PCPTGZ5,PWET5,PQS5,PCPTS5)  

!*         2.5    COMPUTATION OF THE MODIFIED ROUGHNESS LENGTHS.

IF (LLVDF5) THEN
  CALL EXCHCO_VDF(KDLEN,1,ILEN,&
  & ZUF5,ZVF5,PU10N5,PV10N5,&
  & PAPHI5(1,NFLEVG),PZ05,&
  & PRI5,PBN5,PBM5)
ELSE
 CALL EXCHCO(&
 & KDLEN,1,ILEN,&
 & PQN5(1,NFLEVG),PTF5(1,NFLEVG),&
 & PAPHI5(1,NFLEVG),ZAPHIH5(1,NFLEVG),PRF5(1,NFLEVG),&
 & PTS5,ZUF5,ZVF5,PZ05,PWET5,PQS5,&
 & PRI5,PBN5,PBM5,PBH5)  
ENDIF

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