SUBROUTINE ASCATSM_CDFMATCH(KSCATP)


!**** ROUTINE SCATT_TRAFO ****

!          Klaus Scipal ECMWF          23/MAY/2007

!*    METHOD
!     ------
!      Routine to "calibrates" the relative soil moisture index obtained from ASCAT
!      by a linear transform (this can latter be changed to a CDF transform if necessary)
!      the parameters for the linear transform are generated offline and are raed in
!      in routine scatsm_cdfpar called by scat_ob

!      In this step ASCAT data is also screened, i.e. data over mountains, wetlands are
!      set to missing. Missing is also set if the noise is too high or if the ASCAT
!      processing flag indicates problems during the soil moisture retrieval.

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

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

!*   MODIFICATIONS
!     -------------
!    P de Rosnay Oct 2009 Not use ASCATSM for high incidence angles 

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

USE PARKIND1  ,ONLY : JPIM, JPRB
USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
USE YOMANCS   ,ONLY : RADIANS, RDEGREES, RMDI, &
    &                 EPSMAC,RTICE,RTWAT,R2ES,R3LES,R3IES,R4LES,R4IES,RTT
USE YOMLUN    ,ONLY : NULOUT
USE YOMCST    ,ONLY : RPI
USE YOMDB
USE YOMASCATSM

IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN) :: KSCATP

INTEGER(KIND=JPIM)             :: JALL, II, JJ, ISM, ITSM, IND

REAL(KIND=JPRB)                :: ZOBS_LAT, ZOBS_LON
REAL(KIND=JPRB)                :: ZHOOK_HANDLE

#include "fcobs.h"
#include "stmfun_ifs.h"
#include "openmp_obs.h"

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

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



!*      1.   PREPARE SOIL MOISTURE TRANSFORMATION


!*      1.1  get positions of soil moisture and scaled soil moisture in body array

DO JALL = MLNKH2B(KSCATP),MLNKH2B(KSCATP+1)-1
   IF (ROBODY(JALL,MDBVNM) == 179) ISM=JALL
   IF (ROBODY(JALL,MDBVNM) == 180) ITSM=JALL
!   WRITE(NULOUT,'(''   ODB index: '',I5,1X,2(F7.2,1x))') JALL, ROBODY(JALL,MDBVNM), ROBODY(JALL,MDBVAR)
ENDDO

!*      1.2 initialise sm fields with missing value

ROBODY(ITSM,MDBVAR)=RMDI
ROBODY(ITSM,MDB_AUX_AT_BODY(1))=RMDI
ROBODY(ITSM,MDB_AUX_AT_BODY(2))=RMDI
ROBODY(ITSM,MDBOER)=RMDI
ROBODY(ITSM,MDBFOE)=RMDI

ROBODY(ISM,MDBOER)=RMDI
ROBODY(ISM,MDBFOE)=RMDI
ROBODY(ISM,MDBOMF)=RMDI
ROBODY(ISM,MDBOMN)=RMDI



!*      2.   DO THE TRANSFORMATION IF SOIL MOISTURE VALUE IS OK
!*            - processing flag must be 0 (otherwise meas. is corrupted)
!*            - meas. must range between 0 and 100
!*            - noise value should be below 7
!*            - water fraction should be below 15% and topo index below 20%
!*            - trafo parameters must exist (checked under #2.1)
!*            - cellno must be between 10 and 25 (cf rd memo 0953, de Rosnay 2009) 

IF ((ROBODY(ISM,MDBVAR)<=100.).AND.(ROBODY(ISM,MDBVAR)>= 0.).AND. &
   & (SATBODY(ISM,MDBSCSMP)==0).AND.(SATBODY(ISM,MDBSCSMW)<=15).AND. &
   & (SATBODY(ISM,MDBSCSMS)>0.1).AND.(SATBODY(ISM,MDBSCSMS)<=7.).AND. &
   & (SATBODY(ISM,MDBSCSMT)<=20).AND.(SATHDR(KSCATP,MDBSCCNO)>10).AND. &
   & (SATHDR(KSCATP,MDBSCCNO)<27)) THEN

!*      2.1 get nearest neighbour transformation parameters

   ZOBS_LAT   = ROBHDR(KSCATP,MDBLAT) * RDEGREES
   ZOBS_LON   = ROBHDR(KSCATP,MDBLON) * RDEGREES
   IF (ZOBS_LON<0.) ZOBS_LON=ZOBS_LON+360.

   II=NINT((ZOBS_LAT-ZLAT0)/ZLATI0+1._JPRB)
   JJ=NINT((ZOBS_LON*RADIANS*FLOAT(ILONE(II)))/(RPI*2._JPRB)+1._JPRB)
   IND=SUM(ILONE(1:II-1))+JJ
!   WRITE(NULOUT,*) 'ASCAT TRAFO 0 : ', II, JJ, IND

!*       2.2 do transformation and write back to odb
!*           - check if trafo parameters are not missing for respective location
!*           - check noise (done inside if clause as trafo parameters are needed)

   IF ((A(IND) /= RMDI).AND.(B(IND) /= RMDI).AND.(B(IND) /= 0)) THEN

      ROBODY(ITSM,MDB_AUX_AT_BODY(1))=A(IND)
      ROBODY(ITSM,MDB_AUX_AT_BODY(2))=B(IND)

      ROBODY(ITSM,MDBOER)=ABS(B(IND)*SATBODY(ISM,MDBSCSMS)/100._JPRB)
      ROBODY(ITSM,MDBFOE)=ROBODY(ITSM,MDBOER)

      ROBODY(ITSM,MDBVAR)=A(IND)+B(IND)*ROBODY(ISM,MDBVAR)/100._JPRB

      ! as the transformation equalises statistical properties occasionally negative values can "happen"
      ! these are set to 0.
      IF (ROBODY(ITSM,MDBVAR) < 0.) ROBODY(ITSM,MDBVAR)=0._JPRB

!      WRITE(NULERR,*) 'ASCAT TRAFO: ', A(IND), B(IND), ROBODY(ISM,MDBVAR),ROBODY(ITSM,MDBVAR)
!      WRITE(NULOUT,'(''ASCAT CD: '',6(F9.3,1X))') &
!         &  ZOBS_LON, ZOBS_LAT,PLON, PLAT,  A(IND),B(IND)
!      WRITE(NULOUT,'(''ASCAT SM: '',4(F8.2,1X))') &
!         & ROBODY(ISM,MDBVAR),SATBODY(ISM,MDBSCSMS),ROBODY(ITSM,MDBVAR),ROBODY(ITSM,MDBOER)
!      WRITE(NULOUT,'(''ASCAT FL: '',2(F8.3,1X))') SATBODY(ISM,MDBSCSMW), SATBODY(ISM,MDBSCSMT)

   ENDIF

ENDIF

CALL FLUSH(NULOUT)

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

END SUBROUTINE ASCATSM_CDFMATCH
