! (C) Copyright 2001- ECMWF.
! (C) Copyright 2001- Meteo-France.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!

SUBROUTINE DIR_TRANS_FIELD_API(KRESOL,                &
                             & YDFSCALAR, YDFU, YDFV, &
                             & YDFSPSCALAR, YDFSPVOR,YDFSPDIV)

!**** *DIR_TRANS_FIELD_API* - Field API interface to direct spectral transform

!     Purpose.
!     --------
!        Allow to call DIR_TRANS with a list of fields from field API

!**   Interface.
!     ----------
!     CALL DIR_TRANS_FIELD_API(...)

!     Explicit arguments :
!     --------------------
!      output
!       YDFSPVOR(:)    - List of spectral vector fields (vorticity)
!       YDFSPDIV(:)    - List of spectral vector fields (divergence)
!       YDFSPSCALAR(:) - List of spectral scalar fields
!      input
!       KRESOL         -
!       YDFSCALAR(:)   - List of grid-point scalar fields
!       YDFU(:)        - List of grid-point vector fields (u)
!       YDFV(:)        - List of grid-point vector fields (v)
!      output
!       YDFSPSCALAR(:) - List of spectral scalar fields
!       YDFSPVOR(:)    - List of spectral vector fields (vorticity)
!       YDFSPDIV(:)    - List of spectral vector fields (divergence)
!
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK, JPHOOK
USE ECTRANS_FIELD_API_MOD, ONLY: FIELD_GRID, FIELD_SPEC, SPEC_VIEW, GRID_VIEW, LS_COUNT, LG_COUNT, LS, LG, &
                               & GET_LAYOUT_S, GET_LAYOUT_G, IVSET_PTR
USE PARKIND1  ,ONLY : JPIM,JPRB, JPRD

IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: KRESOL
TYPE(FIELD_GRID),INTENT(IN), OPTIONAL  :: YDFSCALAR(:), YDFU(:), YDFV(:)
TYPE(FIELD_SPEC),INTENT(INOUT), OPTIONAL  :: YDFSPSCALAR(:), YDFSPVOR(:), YDFSPDIV(:)

! Local variables

! List of FIELD_VIEW: intermediate representation of fields to facilitate copy to temporary arrays
TYPE(SPEC_VIEW), ALLOCATABLE  :: YLSPVVOR(:), YLSPVDIV(:)
TYPE(SPEC_VIEW), ALLOCATABLE  :: YLSPVSCALAR(:)

TYPE(GRID_VIEW), ALLOCATABLE  :: YLGVU(:),YLGVV(:)
TYPE(GRID_VIEW), ALLOCATABLE  :: YLGVSCALAR(:)

! Temporary arrays for dir_trans
REAL(KIND=JPRB),POINTER :: ZPSPVOR(:,:),ZPSPDIV(:,:)  ! spectral vector fields (out)
REAL(KIND=JPRB),POINTER :: ZPSPSC2(:,:)               ! spectral scalar fields(out)
REAL(KIND=JPRB),POINTER :: ZPGPUV(:,:,:,:)            ! grid vector fields (in)
REAL(KIND=JPRB),POINTER :: ZPGP2(:,:,:)               ! grid scalar fields (in)

REAL(KIND=JPRB), POINTER :: ZZ1_1(:)
REAL(KIND=JPRB), POINTER :: ZZ1_2(:)
REAL(KIND=JPRB), POINTER :: ZZ2_1(:,:)
REAL(KIND=JPRB), POINTER :: ZZ2_2(:,:)
REAL(KIND=JPRB):: S

! b-set for dir-trans
INTEGER(KIND=JPIM),ALLOCATABLE :: IVSETUV(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: IVSETSC2(:)
TYPE(IVSET_PTR), ALLOCATABLE :: IVSETUV_LIST(:)
TYPE(IVSET_PTR), ALLOCATABLE :: IVSETSC_LIST(:)

INTEGER(KIND=JPIM) :: NSPEC2
INTEGER(KIND=JPIM) :: NPROMA
INTEGER(KIND=JPIM) :: NBLK
INTEGER(KIND=JPIM) :: KGPTOT
INTEGER(KIND=JPIM) :: NFLEVG

INTEGER(KIND=JPIM) :: IFLDXG
INTEGER(KIND=JPIM) :: IFLDXL
INTEGER(KIND=JPIM) :: IFLDSPVOR
INTEGER(KIND=JPIM) :: IFLDSPSC
INTEGER(KIND=JPIM) :: IUVG
INTEGER(KIND=JPIM) :: IUVDIM
INTEGER(KIND=JPIM) :: ID
INTEGER(KIND=JPIM) :: IOFFSET
INTEGER(KIND=JPIM) :: JLEV      ! Level counter
INTEGER(KIND=JPIM) :: JFLD      ! Field counter
INTEGER(KIND=JPIM) :: C
LOGICAL            :: LDACC     ! INDICATING IF WE ARE RUNNING ON THE GPU
REAL(KIND=JPHOOK)  :: ZHOOK_HANDLE

#include "dir_trans.h"
#include "abor1.intfb.h"

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('DIR_TRANS_FIELD_API',0,ZHOOK_HANDLE)

NBLK = 0 
NPROMA = 0 
NSPEC2 = 0

IF (PRESENT(YDFU))        CALL GET_LAYOUT_G(YDFU, NBLK, NPROMA)
IF (PRESENT(YDFV))        CALL GET_LAYOUT_G(YDFV, NBLK, NPROMA)
IF (PRESENT(YDFSCALAR))   CALL GET_LAYOUT_G(YDFSCALAR,NBLK, NPROMA)
IF (PRESENT(YDFSPVOR))    CALL GET_LAYOUT_S(YDFSPVOR, NSPEC2)
IF (PRESENT(YDFSPDIV))    CALL GET_LAYOUT_S(YDFSPDIV, NSPEC2)
IF (PRESENT(YDFSPSCALAR)) CALL GET_LAYOUT_S(YDFSPSCALAR, NSPEC2)
IF (PRESENT(YDFSPVOR))    CALL GET_LAYOUT_S(YDFSPVOR, NSPEC2)

! Assert that NBLK, NPROMA and NSPEC2 are properly valued after getting the field(s) layout
IF (.NOT.(NBLK > 0))    CALL ABOR1("[DIR_TRANS_FIELD_API] NBLK must be strictly positive. &
                                        &  One or more field arguments might be missing.")
IF (.NOT.(NPROMA > 0))  CALL ABOR1("[DIR_TRANS_FIELD_API] NPROMA must be strictly positive. &
                                        &  One or more field arguments might be missing.")
IF (.NOT.(NSPEC2 > 0))  CALL ABOR1("[DIR_TRANS_FIELD_API] NSPEC2 must be strictly positive. &
                                        &  One or more field arguments might be missing.")


IFLDXG  = 0
IFLDXL = 0
IFLDSPVOR= 0
IFLDSPSC= 0
IUVG = 0
JFLD  = 0
IUVDIM = 0
ID = 0
IOFFSET = 0
JLEV = 0
JFLD = 0

! We are still relying on DIR_TRANS, which require to have all the data are on CPU.
! So we force using data on the host
LDACC = .FALSE.

! 1. Vector fields transformation to spectral space

! Do we have vector fields?
IF (PRESENT(YDFU)) THEN

  IF (.NOT. PRESENT(YDFV))     CALL ABOR1("[DIR_TRANS_FIELD_API] YDFU and YDFV must be provided together for vector transform")
  IF (.NOT. PRESENT(YDFSPVOR)) CALL ABOR1("[DIR_TRANS_FIELD_API] YDFSPVOR must be provided for vector transform")
  IF (.NOT. PRESENT(YDFSPDIV)) CALL ABOR1("[DIR_TRANS_FIELD_API] YDFSPDIV must be provided for vector transform")

  IF ((SIZE(YDFU)/= SIZE(YDFV)).OR.(SIZE(YDFU)/= SIZE(YDFSPDIV)).OR.(SIZE(YDFU)/= SIZE(YDFSPVOR))) THEN
     CALL ABOR1("[DIR_TRANS_FIELD_API] The vector arrays have inconsistent sizes: YDFU, YDFV, YDFSPDIV, YDFSPVOR")
  ENDIF

  ! Convert list of spectral vector fields into a list of 2d FIELD_VIEW
  IFLDSPVOR = LS_COUNT(YDFSPVOR)

  ALLOCATE(YLSPVVOR(IFLDSPVOR))
  ALLOCATE(YLSPVDIV(IFLDSPVOR))

  ! Convert list of grid-point vector fields into a list of 2d FIELD_VIEW
  ALLOCATE(YLGVU(LG_COUNT(YDFU)))
  ALLOCATE(YLGVV(LG_COUNT(YDFV)))
  IF ((SIZE (YLGVU) /= SIZE (YLGVV)) .OR. (SIZE (YLSPVVOR) /= SIZE (YLSPVDIV))) THEN
     CALL ABOR1("[DIR_TRANS_FIELD_API] inconsistent number of field_view for vectors")
  ENDIF
  NFLEVG = SIZE (YLGVU) / SIZE (YDFU)
  IUVG = SIZE(YDFU)

  IUVDIM = 2

  ! allocate temporary vector field arrays in spectral space
  ALLOCATE(ZPSPVOR(IFLDSPVOR,NSPEC2))
  ALLOCATE(ZPSPDIV(IFLDSPVOR,NSPEC2))

  ! allocate temporary vector field array in grid space
  ALLOCATE(ZPGPUV(NPROMA,NFLEVG, IUVG * IUVDIM,NBLK))

  ! For LG we need the ivset of each grid point field,
  ! so we extract a matching list from the spectral fields.
  ALLOCATE(IVSETUV_LIST(IUVG))
  DO JFLD=1,IUVG
    IVSETUV_LIST(JFLD)%PTR => YDFSPVOR(JFLD)%IVSET
  ENDDO

  C = LG(YDFU, YLGVU, IVSETUV_LIST, LDACC, .TRUE.)
  C = LG(YDFV, YLGVV, IVSETUV_LIST, LDACC, .TRUE.)

  ! Copy list of 2d views of grid point vector fields into temporary arrays
  IOFFSET = 0
  DO JFLD=1,IUVG
    DO JLEV=1,NFLEVG
      ID = JLEV + (JFLD -1) * NFLEVG
      ZZ2_1=>YLGVU(ID)%P
      ZZ2_2=>YLGVV(ID)%P

      ZPGPUV(:,JLEV,JFLD+IOFFSET*IUVG,:) = ZZ2_1(:,:)
      ZPGPUV(:,JLEV,JFLD+(IOFFSET+1)*IUVG,:) = ZZ2_2(:,:)
    ENDDO
  ENDDO

  ALLOCATE(IVSETUV(NFLEVG))
  DO JFLD=1,IUVG
    DO JLEV=1,NFLEVG
      ID = JLEV + (JFLD -1) * NFLEVG
      IF (JFLD .EQ. 1) THEN
        IVSETUV(JLEV) = YLGVU(ID)%IVSET
      ENDIF
      IF (IVSETUV(JLEV) .NE. YLGVV(ID)%IVSET)  CALL ABOR1("[DIR_TRANS_FIELD_API] ivsetuv inconsistent with ylgvv%ivset")
    ENDDO
  ENDDO
ELSE
  ! No vector field provided
  IUVG = 0
  ZPGPUV=>NULL()
  ZPSPVOR=>NULL()
  ZPSPDIV=>NULL()
ENDIF

! 2. scalar fields transformation

! Preliminary checks
IF (PRESENT(YDFSPSCALAR) .NEQV. PRESENT(YDFSCALAR))  CALL ABOR1("[DIR_TRANS_FIELD_API] YDFSPSCALAR and YDFSCALAR &
                                                               & must be provided together")

! Do we have scalar fields?
IF (PRESENT(YDFSPSCALAR)) THEN
  IF ((SIZE(YDFSPSCALAR)/= SIZE(YDFSCALAR)))  CALL ABOR1("[DIR_TRANS_FIELD_API] Inconsistent size &
                                                         & for YDFSPSCALAR and YDFSCALAR")

  ! Convert list of spectral scalar fields of any dimension into a list of 2d fields
  ALLOCATE(YLGVSCALAR(LG_COUNT(YDFSCALAR)))

  IFLDXG = SIZE(YLGVSCALAR)

  IFLDSPSC = LS_COUNT(YDFSPSCALAR)
  ALLOCATE(YLSPVSCALAR(IFLDSPSC))

  ! count the number of fields present on the processor
  C = LS(YDFSPSCALAR, YLSPVSCALAR, LDACC,.TRUE.)
  IFLDXL = 0
  DO JFLD = 1, IFLDSPSC
    IF (ASSOCIATED(YLSPVSCALAR(JFLD)%P)) IFLDXL = IFLDXL + 1
  END DO
   ! Allocate temporary scalar field array in spectral space
  ALLOCATE(ZPSPSC2(IFLDXL,NSPEC2))

  ! Allocate temporary scalar field array in grid space
  ALLOCATE(ZPGP2(NPROMA,IFLDXG,NBLK))

  ! For LG we need the ivset of each grid point field,
  ! so we extract a matching list from the spectral fields
  ALLOCATE(IVSETSC_LIST(SIZE(YDFSPSCALAR)))
  DO JFLD=1,SIZE(YDFSPSCALAR)
    IVSETSC_LIST(JFLD)%PTR => YDFSPSCALAR(JFLD)%IVSET
  ENDDO

  ! Copy list of scalar fields into temporary arrays (2d copy thanks to field_view)
  C = LG(YDFSCALAR, YLGVSCALAR, IVSETSC_LIST, LDACC,.TRUE.)
  ALLOCATE(IVSETSC2(IFLDXG))
  DO JFLD=1, IFLDXG
    ZZ2_1=>YLGVSCALAR(JFLD)%P
    ZPGP2(:,JFLD,:) = ZZ2_1(:,:)
    IVSETSC2(JFLD) = YLGVSCALAR(JFLD)%IVSET
  ENDDO

ELSE
  !No scalar field provided
  IFLDXG = 0
  ZPGP2=>NULL()
  ZPSPSC2=>NULL()
ENDIF

! 3. CALL DIR_TRANS using the regular interface and the temporary arrays

! We have to perform separated calls for nvfortran
IF (ASSOCIATED(ZPGP2) .AND. ASSOCIATED(ZPGPUV)) THEN
	CALL DIR_TRANS(PSPVOR = ZPSPVOR,PSPDIV = ZPSPDIV,PGPUV = ZPGPUV,KVSETUV = IVSETUV, &
	             & PSPSC2 = ZPSPSC2,PGP2 = ZPGP2, KVSETSC2 = IVSETSC2, &
	             & KPROMA = NPROMA, KRESOL = KRESOL)
ELSE IF (ASSOCIATED(ZPGP2)) THEN
	CALL DIR_TRANS(PSPSC2 = ZPSPSC2,PGP2 = ZPGP2, KVSETSC2 = IVSETSC2, &
	             & KPROMA = NPROMA, KRESOL = KRESOL)
ELSE IF (ASSOCIATED(ZPGPUV)) THEN
	CALL DIR_TRANS(PSPVOR = ZPSPVOR,PSPDIV = ZPSPDIV,PGPUV = ZPGPUV,KVSETUV = IVSETUV, &
	             & KPROMA = NPROMA, KRESOL = KRESOL)
ENDIF
! 4. Copy back temporary array data into spectral fields

! copy spectral vorticity and divergence
IF (IUVG>0) THEN

    C = LS(YDFSPVOR, YLSPVVOR, LDACC, .FALSE.)
    C = LS(YDFSPDIV, YLSPVDIV, LDACC, .FALSE.)

    DO JFLD=1,IFLDSPVOR
      IF (ASSOCIATED(YLSPVVOR(JFLD)%P)) THEN
        ZZ1_1=>YLSPVVOR(JFLD)%P
        ZZ1_2=>YLSPVDIV(JFLD)%P
        ZZ1_1(:) = ZPSPVOR(JFLD,:)
        ZZ1_2(:) = ZPSPDIV(JFLD,:)
      ENDIF
    ENDDO
ENDIF

! copy spectral scalar fields
 IF (IFLDSPSC > 0) THEN

   C = LS(YDFSPSCALAR, YLSPVSCALAR, LDACC,.FALSE.)
   ID = 1
   DO JFLD = 1, IFLDSPSC
      IF (ASSOCIATED(YLSPVSCALAR(JFLD)%P)) THEN
        ZZ1_1=>YLSPVSCALAR(JFLD)%P
        ZZ1_1(:) = ZPSPSC2(ID,:)
        ID = ID + 1
      ENDIF
   ENDDO
  ENDIF

! 5. Final cleanup

! delete temporary arrays

IF (ASSOCIATED(ZPSPVOR)) DEALLOCATE(ZPSPVOR)
IF (ASSOCIATED(ZPSPDIV)) DEALLOCATE(ZPSPDIV)
IF (ASSOCIATED(ZPSPSC2)) DEALLOCATE(ZPSPSC2)
IF (ASSOCIATED(ZPGPUV))  DEALLOCATE(ZPGPUV)
IF (ASSOCIATED(ZPGP2))   DEALLOCATE(ZPGP2)
IF (ALLOCATED(IVSETUV))  DEALLOCATE(IVSETUV)
IF (ALLOCATED(IVSETSC2)) DEALLOCATE(IVSETSC2)

! delete FIELD_VIEWS
IF (ALLOCATED(YLSPVVOR))    DEALLOCATE(YLSPVVOR)
IF (ALLOCATED(YLSPVDIV))    DEALLOCATE(YLSPVDIV)
IF (ALLOCATED(YLSPVSCALAR)) DEALLOCATE(YLSPVSCALAR)
IF (ALLOCATED(YLGVU))       DEALLOCATE(YLGVU)
IF (ALLOCATED(YLGVV))       DEALLOCATE(YLGVV)
IF (ALLOCATED(YLGVSCALAR))  DEALLOCATE(YLGVSCALAR)

IF (LHOOK) CALL DR_HOOK('DIR_TRANS_FIELD_API',1,ZHOOK_HANDLE)
!     ------------------------------------------------------------------

END SUBROUTINE DIR_TRANS_FIELD_API