SUBROUTINE ASCATSM_CDFPAR

!**** ROUTINE SCATSM_CDFPAR ****

!          K. Scipal ECMWF          23/MAY/2007

!*    METHOD
!     ------
!         reads in parameters for scat soil moisture transformation
!         using general IO method

!         it is a linear transform, so two parameters are needed which are currently
!         stored as seperate T159 RGG grib CLFs (a.grib, b.grib) in $WDIR

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


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


!*   MODIFICATIONS
!     -------------
!      P de Rosnay (13.10.2009): New grid codes 228253 and 228254 for ASCAT parameters

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

USE YOMHOOK    ,ONLY : LHOOK, DR_HOOK
USE YOMANCS    ,ONLY : RMDI, RDEGREES
USE YOMLUN     ,ONLY : NULOUT
USE YOMASCATSM
USE IOSTREAM_MIX   ,ONLY : SETUP_IOSTREAM, SETUP_IOREQUEST, IO_GET, CLOSE_IOSTREAM, &
    &                 TYPE_IOSTREAM, TYPE_IOREQUEST, CLOSE_IOREQUEST, IO_INQUIRE
USE YOMGRB  , ONLY :  NGRBASCAT_SM_CDFA, NGRBASCAT_SM_CDFB 
USE PARDIM     ,ONLY : JPMXGL
USE MPL_MODULE ,ONLY : MPL_BROADCAST

IMPLICIT NONE


INTEGER(KIND=JPIM)           :: II, INPTE, IFIELDS
INTEGER(KIND=JPIM)           :: IGRIB2D(2)

REAL(KIND=JPRB)              :: ZHOOK_HANDLE
REAL(KIND=JPRB)              :: ZLATE(JPMXGL)
REAL(KIND=JPRB), ALLOCATABLE :: ZCDF(:,:,:)

CHARACTER (LEN=7)            :: CLF

TYPE(TYPE_IOSTREAM)          :: YL_IOSTREAM
TYPE(TYPE_IOREQUEST)         :: YL_IOREQUEST


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

WRITE(NULOUT,*) 'START SCATSM_CDFPAR'
CALL FLUSH(NULOUT)



   !*       0. Define Grib Parameters

   !* as the transformation parameters do not have a grib code,
   !* we use the soil moisture layer1/layer2 code. this has no effect
   !* on the IO but ensures that IOSTREAM_MIX does not complain

   IFIELDS=2
   IGRIB2D(1) = 228253
   IGRIB2D(2) = 228254


   !*       1. Allocate Arrays

   !* To allocate arrays get grib header information using IO_INQUIRE from one of the CLFs

   CLF='ascatsm'
   WRITE(NULOUT,*) 'ASCATSM_CDFPAR: IO_INQUIRE'
   CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLF),CDMODE='r',KIOMASTER=1)!
   CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE., &
                     & KGRIB2D=IGRIB2D(1:IFIELDS))
   CALL IO_INQUIRE(YL_IOSTREAM,YL_IOREQUEST,KLATS=INROWS,KLONS=ILONE,PLATS=ZLATE)
   CALL CLOSE_IOREQUEST(YL_IOREQUEST)
   CALL CLOSE_IOSTREAM(YL_IOSTREAM)


   INPTE = SUM(ILONE(1:INROWS))
   ALLOCATE (A(INPTE))
   ALLOCATE (B(INPTE))
   ALLOCATE (ZCDF(INPTE,2,1))

   ZCDF(:,:,1)=-9999._JPRB
   WRITE(NULOUT,*) 'ALLOCATION DONE IN CDFPAR'

   !*      2. Read transformation parameters


   CLF = 'ascatsm'
   WRITE(NULOUT,*) 'CDF PAR CLF TO READ: ', CLF
   CALL SETUP_IOSTREAM(YL_IOSTREAM,'CIO',TRIM(CLF),CDMODE='r',KIOMASTER=1)
   WRITE(NULOUT,*) 'CDFPAR: start IOREQUEST'
   CALL SETUP_IOREQUEST(YL_IOREQUEST,'GRIDPOINT_FIELDS',LDGRIB=.TRUE.,KPROMA=INPTE,&
                     & KGRIB2D=IGRIB2D(1:IFIELDS),LDISTRIBUTE=.FALSE.)
   WRITE(NULOUT,*) 'CDFPAR: start IO_GET'
   CALL IO_GET(YL_IOSTREAM,YL_IOREQUEST,PR3=ZCDF)
   WRITE(NULOUT,*) 'CDFPAR: start IOREQUEST'
   CALL CLOSE_IOREQUEST(YL_IOREQUEST)
   WRITE(NULOUT,*) 'CDFPAR: start IOSTREAM'
   CALL CLOSE_IOSTREAM(YL_IOSTREAM)

   !*      3. resort arrays and use IFS missing value

   do II = 1, INPTE
   if ((ZCDF(II,1,1) == -9999.).OR.(ZCDF(II,2,1) == -9999.)) then
         A(II)=RMDI
         B(II)=RMDI
      else
         A(II)=ZCDF(II,1,1)
         B(II)=ZCDF(II,2,1)
   !      WRITE(NULOUT,*) 'CDF PAR : ',A(II),B(II)
      endif
   enddo


   !*      4. calculate parameters necesary for nearest neighbour indexing
   !*         these are stored in module yomascatsm

   ZLAT0=ZLATE(1)*RDEGREES*1._JPRB
   ZLATI0=-2._JPRB*ZLAT0/REAL(INROWS-1)

   CALL MPL_BROADCAST(A,KROOT=1,KTAG=2221,CDSTRING='ASCATSM_CDFPAR_A:')
   CALL MPL_BROADCAST(B,KROOT=1,KTAG=2222,CDSTRING='ASCATSM_CDFPAR_B:')

   !*      5. cleanup

  if (allocated(ZCDF)) deallocate(ZCDF)


CALL FLUSH(NULOUT)

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


END SUBROUTINE ASCATSM_CDFPAR
