SUBROUTINE AMV_REASSIGN(kdlen,klen,kgrp,plat,plon,pdp)  

!**** *AMV_REASSIGN - Performs the pressure reassignment for AMV/SATOBs

!     Niels Bormann    ECMWF     22/06/2001

!     PURPOSE
!     -------
!     Routine to calculate the pressure reassignment for AMVs/SATOBs, based 
!     on the regression information from tpc_info. tpc_info is set up by
!     suamv.F90. 

!**   ARGUMENTS/INTERFACE
!     -------------------
!     kdlen     = First dimension: Max number of observations, this set
!     klen      = Actual number of obs, this set
!     kgrp      = Number of satob group 
!     plat,plon = Latitude/longitude of obs points [deg]
!     pu,pv     = u, v wind component of AMV [m/s]
!     pdp       = Originally assigned pressure of AMV [Pa]

!     amv_reassign is called by hretr.

!**   METHOD
!     ------
!     amc_reassign selects the requested predictors (given by their names 
!     in tpc_info) and calculates the reassignment based on these.
!     amv_reassign can deal with multiple observations, but it assumes that all
!     AMVs provided use the same reassignment model given by 
!     SATOBGRP_TABLE(KGRP)%ipcor.

!**   MODIFICATIONS
!     -------------
!----------------------------------------------------------------------

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

USE yomtvrad, ONLY : satobgrp_table
USE yom_amv_reassign, ONLY : tpc_info, npc_info
USE yomlun   , ONLY : nulout
USE yomdb
USE yomancs  , ONLY : rmdi

IMPLICIT NONE

! Arguments
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN ! Number of obs
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN ! Number of obs in set
INTEGER(KIND=JPIM),INTENT(IN)    :: KGRP ! Correction model to be used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT(KDLEN) ! Latitude of profile/obs
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLON(KDLEN) ! Longitude of profile/obs
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDP(KDLEN) ! Assigned/reassigned pressure of obs [Pa]

! Local variables

REAL(KIND=JPRB), ALLOCATABLE, DIMENSION(:,:)   :: zpreds    ! Predictors needed
REAL(KIND=JPRB), DIMENSION(kdlen)              :: zp        ! Original pressure
REAL(KIND=JPRB), DIMENSION(kdlen)              :: zexparg

INTEGER(KIND=JPIM)                             :: jpred, jcor
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "openmp_obs.h"

!====================================================

!*       1   Preparations
!            ------------

IF (LHOOK) CALL DR_HOOK('AMV_REASSIGN',0,ZHOOK_HANDLE)
IF(npc_info <= 0 .AND. LHOOK) CALL DR_HOOK('AMV_REASSIGN',1,ZHOOK_HANDLE)
IF(npc_info <= 0) RETURN

WHERE ( pdp(1:klen) < 10000._JPRB) pdp(1:klen) = 10000._JPRB

! Avoid problems if re-assignment has been done (e.g., in case of 
! re-run of 4dvar job after crash)
IF(ANY(SATHDR(1:klen,MDB_P_OLD_AT_SATOB) /= rmdi ))THEN
  satobgrp_table(kgrp)%oerr_factor = 1._JPRB
  WRITE(nulout,*) 'WARNING amv_reassign: Detected rerun of amv_reassign.'
  WRITE(nulout,*) '  No obs error adjustments will be applied to avoid '
  WRITE(nulout,*) '  potential problems.'
ENDIF

WHERE ( SATHDR(1:klen,MDB_P_OLD_AT_SATOB) /= rmdi )
  zp(1:klen) = SATHDR(1:klen,MDB_P_OLD_AT_SATOB)
ELSEWHERE
  zp(1:klen) = pdp(1:klen)
ENDWHERE

jcor = satobgrp_table(kgrp)%ipcor

!*       3   Select predictors needed
!            ------------------------

IF(tpc_info(jcor)%npreds > 0)THEN
  ALLOCATE(zpreds(kdlen,tpc_info(jcor)%npreds))

  DO jpred = 1, tpc_info(jcor)%npreds
    SELECT CASE (TRIM(tpc_info(jcor)%pred_name(jpred)))
    CASE ('tb')
      IF( ALL(SATHDR(1:klen,MDB_TB_AT_SATOB) /= rmdi) )THEN
        zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_TB_AT_SATOB)
      ELSE
        WRITE(nulout,*) 'ERROR amv_reassign: tb not avail. for these AMVs.'
        WRITE(nulout,*) ' satid,comp_method',tpc_info(jcor)%sat_id,&
         & tpc_info(jcor)%comp_method  
        WRITE(nulout,*) ' No corrections calculated.'
        DEALLOCATE(zpreds)
        IF (LHOOK) CALL DR_HOOK('AMV_REASSIGN',1,ZHOOK_HANDLE)
        RETURN
      ENDIF
    CASE ('t')
      zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_T_AT_SATOB)
    CASE ('t200')
      zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_T200_AT_SATOB)
    CASE ('t500')
      zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_T500_AT_SATOB)
    CASE ('dt_by_dp')
      zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_DT_BY_DP_AT_SATOB)
    CASE ('top_mean_t')
      zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_TOP_MEAN_T_AT_SATOB)
    CASE ('top_wv')
      zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_TOP_WV_AT_SATOB)
    CASE ('|shear+4|')
      zpreds(1:klen,jpred) = ABS(SATHDR(1:klen,MDB_SHEAR_AT_SATOB) &
       & + 4._JPRB)  
    CASE ('|shear|')
      zpreds(1:klen,jpred) = ABS(SATHDR(1:klen,MDB_SHEAR_AT_SATOB))
    CASE ('shear')
      zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_SHEAR_AT_SATOB)
    CASE ('zenith')
      zpreds(1:klen,jpred) = SATHDR(1:klen,MDB_ZENITH_AT_SAT)
    CASE DEFAULT
      WRITE(nulout,*) 'ERROR amv_reassign: Unimplemented predictor name: '//&
       & TRIM(tpc_info(jcor)%pred_name(jpred))  
      WRITE(nulout,*) ' No corrections calculated.'
      DEALLOCATE(zpreds)
      IF (LHOOK) CALL DR_HOOK('AMV_REASSIGN',1,ZHOOK_HANDLE)
      RETURN
    END SELECT

  ENDDO

!*       4   Apply corrections
!            -----------------
  zexparg(1:klen) = LOG(0.1_JPRB) - 1.0_JPRB
  
  WHERE ( zp(1:klen) <= 60000.0_JPRB .AND. ABS(plat(1:klen)) >= 20.0_JPRB )
    zexparg(1:klen) = LOG(zp(1:klen)) + tpc_info(jcor)%coef(0)     &
     & + MATMUL(zpreds(1:klen,:),tpc_info(jcor)%coef(1:tpc_info(jcor)%npreds))  
  ENDWHERE
  WHERE  ( zexparg(1:klen) > LOG(0.1_JPRB) &
     & .AND. zexparg(1:klen) < LOG(110000._JPRB) )  
    pdp(1:klen) = EXP(zexparg(1:klen))
  ELSEWHERE
    pdp(1:klen) = rmdi
  ENDWHERE

!*       4   Tidy up
!            -------

  DEALLOCATE(zpreds)
ELSE
  WRITE(nulout,*) 'AMV_REASSIGN: No corrections applied'
ENDIF

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