SUBROUTINE FP2SX1

! Purpose :
! -------
!   *FP2SX1* Subcontract some work from Fullpos to Surfex

! Interface :
! ---------

! Externals :
! ---------
!   ATM2SX_ENV
!   ATM2SX_FIELD
!   INI_PREP_SURFEX_ARO
!   PREP_SURF_ARO
!   CLOSE_BUFFER_SURFEX
!   SC2RDGFP   
!   SUPPDATE

! Method :
! ------

! Reference :
! ---------

! Author :
! ------
!   23-Mar-2005 R. El Khatib  *METEO-FRANCE*

! Modifications :
! -------------
!   Jun 2007 A.Alias ajout de la variable NGPTOTG pour envoi a SURFEX
! End Modifications
!   Feb 2008 F.Bouyssel envoi de l'orographie "atmospherique" a SURFEX
!-----------------------------------------------------------------------------

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

USE YOMFPSC2 , ONLY : NFPBLOCS ,NFPROMA  ,NFPSTART ,NFPEND   ,NFPSORT
USE YOMFPDIM , ONLY : NFPBFOUT
USE YOMFPC   , ONLY : CFPFMT   ,NFPDOM   ,LPUTZS
USE YOMFPD   , ONLY : NFPLUX   ,NFPGUX   ,NLAT     ,NLON, &
 & RLATS, RLONW, RDELX, RDELY
USE YOMFPG   , ONLY : NFPRGPL, FPLAT0, FPLON0, FPRPK
USE YOMPFPB  , ONLY : GFPBUF   ,NSTAGFPB
USE PTRFPB2  , ONLY : NFP2SX1  ,CFP2SX1  ,MFP2SX1 ,MFPVT0
USE YOMFPGIND, ONLY : NFPRGPNUM
USE YOMCT0   , ONLY : NPOSTS   ,NFRPOS   ,N3DINI  ,JPNPST   , &
 & LELAM    ,NPROC
USE YOMCT1   , ONLY : N1POS
USE YOMMP    , ONLY : MYPROC   ,NPRCIDS
USE YOMTAG   , ONLY : MTAGDISTGP
USE YOMLUN   , ONLY : NULOUT
USE YOMCST   , ONLY : RG
USE YOMAFN   , ONLY : GFP_GFIS
USE YOMGEM, ONLY   : RLOCEN, RMUCEN, RSTRET,NGPTOTG

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JBLOC  ! Index of current NFPROMA block
INTEGER(KIND=JPIM) :: IST    ! Start adress of current block
INTEGER(KIND=JPIM) :: IEND   ! End adress of current block
INTEGER(KIND=JPIM) :: IFLD   ! Index of current fullpos field
INTEGER(KIND=JPIM) :: IFLDFIS! Index of fullpos field for surface geopotential
INTEGER(KIND=JPIM) :: JFLD   ! Index of current surfex field
INTEGER(KIND=JPIM) :: JFP    ! Index of current point
INTEGER(KIND=JPIM) :: JD     ! Index of current subdomain
INTEGER(KIND=JPIM) :: IGPTOT ! local number of gridpoint per subdomain
INTEGER(KIND=JPIM) :: IHH    ! Time range for Surfex
INTEGER(KIND=JPIM) :: IDTIME ! time indicator ;
!                              1 = date of the start. file + model fcast range

INTEGER(KIND=JPIM) :: IDATEF(11) ! *FA* date array

REAL(KIND=JPRB) :: ZGFP(NFPROMA,NFPBFOUT)  ! Extracted fields per blocks
REAL(KIND=JPRB) :: ZREAL(NFPRGPL,NFPBFOUT) ! Extracted fields (per node)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "sc2rdgfp.intfb.h"
#include "suppdate.intfb.h"
#include "abor1.intfb.h"

#include "atm2sx_env.h"
#include "atm2sx_field.h"
#include "ini_prep_surfex_aro.h"
#include "prep_surf_aro.h"
#include "close_buffer_surfex.h"
#include "aro_put_zs.h"

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

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

!     1. prepare date for surfex

IDTIME=1-N3DINI
CALL SUPPDATE(KDTIME=IDTIME,KEVENTTS=NPOSTS,KDIME=JPNPST,KFREVENT=NFRPOS, &
 & K1EVENT=N1POS,KPPDATE=IDATEF)
IHH=IDATEF(4)*3600 + IDATEF(5)*60
IF (IDATEF(6) == 1) THEN
  IHH=IHH+IDATEF(7)*3600
ELSEIF(IDATEF(6) == 2) THEN
  IHH=IHH+IDATEF(7)*3600*24
ENDIF

!     2. Extract fields on core zone

DO JBLOC=1,NFPBLOCS
  IST =NFPSTART(JBLOC)
  IEND=NFPEND(JBLOC)
  CALL SC2RDGFP(NFPROMA,NFPBFOUT,GFPBUF,NSTAGFPB(JBLOC),IST,IEND,ZGFP)
  DO JFLD=1,NFPBFOUT
    DO JFP=IST,IEND
      ZREAL(NFPSORT(JFP,JBLOC),JFLD)=ZGFP(JFP,JFLD)
    ENDDO
  ENDDO
ENDDO

!     3. Call surfex
 
IF (NFPDOM > 1) THEN
  CALL ABOR1('FP2SX1 : NOT READY FOR NFPDOM > 1')
! needs to set KGPTOT, KOFFSET for a new distribution !!
ELSE
  IGPTOT=NFPRGPL
ENDIF

DO JD=1,NFPDOM

!     3.1 Setup environment

  IF (CFPFMT == 'LELAM') THEN
    CALL ATM2SX_ENV(KGPTOT=NFPRGPNUM(1:NPROC),KDLUXG=NFPLUX,KDGUXG=NFPGUX, &
     & KEXTI=0,KEXTJ=0,KYEAR=IDATEF(1),KMONTH=IDATEF(2),KDAY=IDATEF(3),&
     & KTIME=IHH,KYPROC=MYPROC,KPRCIDS=NPRCIDS(1:NPROC),KTAG=MTAGDISTGP,KLUOUT=NULOUT)
  ELSEIF(CFPFMT == 'GAUSS'.OR.CFPFMT == 'MODEL') THEN
    CALL ATM2SX_ENV(KGPTOT=NFPRGPNUM(1:NPROC),KDLUXG=NLON(JD),KDGUXG=NLAT(JD),&
     & KEXTI=0,KEXTJ=0,KGPGLO=NGPTOTG,KYEAR=IDATEF(1),KMONTH=IDATEF(2),KDAY=IDATEF(3),&
     & KTIME=IHH,KYPROC=MYPROC,KPRCIDS=NPRCIDS(1:NPROC),KTAG=MTAGDISTGP,KLUOUT=NULOUT)
  ELSE
    CALL ATM2SX_ENV(KGPTOT=NFPRGPNUM(1:NPROC),KDLUXG=NLON(JD),KDGUXG=NLAT(JD),&
     & KEXTI=0,KEXTJ=0,KYEAR=IDATEF(1),KMONTH=IDATEF(2),KDAY=IDATEF(3),&
     & KTIME=IHH,KYPROC=MYPROC,KPRCIDS=NPRCIDS(1:NPROC),KTAG=MTAGDISTGP,KLUOUT=NULOUT)
  ENDIF

!     3.2 Re-direct surface fields in surfex buffer

  DO JFLD=1,NFP2SX1
    IFLD=MFP2SX1(JFLD)
    CALL ATM2SX_FIELD(PFIELD=ZREAL(1:IGPTOT,IFLD),HNAME=TRIM(CFP2SX1(JFLD)))
    IF ( MFPVT0(MFP2SX1(JFLD)) == GFP_GFIS%ICOD ) IFLDFIS=IFLD
  ENDDO

!     3.r3 Invoke Surfex

  CALL INI_PREP_SURFEX_ARO(FPLAT0, FPLON0, FPRPK, RLATS(1), RLONW(1),&
 &  NFPLUX, NFPGUX, RDELX(1), RDELY(1), RLOCEN, RMUCEN, RSTRET )
  IF (LPUTZS) CALL ARO_PUT_ZS('AROME ',IGPTOT,ZREAL(1:IGPTOT,IFLDFIS)/RG)
  CALL PREP_SURF_ARO
  CALL CLOSE_BUFFER_SURFEX

ENDDO

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

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

END SUBROUTINE FP2SX1
