SUBROUTINE FPTRDTOA(KC,KFLDS,PFIELD_DEP,PFIELD_ARR)


!**** *FPTRDTOA*  - FULL-POS TRANSPOSITION.
!                   Departure geometry DM-distribution towards
!                   arrival geometry DM-distribution.

!     PURPOSE.
!     --------

!**   INTERFACE.
!     ----------
!       *CALL* *FPTRDTOA*

!        EXPLICIT ARGUMENTS
!        --------------------
!         INPUT:
!          KC:         1: one call of DIWRGRFP+DISGRIDFP per field
!                      2: one call of DIWRGRFP+DISGRIDFP for all fields
!          KFLDS:      number of fields to be transposed.
!          PFIELD_DEP: array with departure geometry DM-distribution.

!         OUTPUT:
!          PFIELD_ARR: array with arrival geometry DM-distribution.

!        IMPLICIT ARGUMENTS
!        --------------------
!        See lower #include.

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS
!        Documentation about FULL-POS.

!     AUTHOR.
!     -------
!        K. Yessad (CNRM/GMAP)
!        ORIGINAL : 21-Mar-2007

!     MODIFICATIONS.
!     --------------
!     End modifications
!     ------------------------------------------------------------------

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

USE YOMFPG   , ONLY : NFPRGPG  ,NFPRGPL  ,NFPRGPLX ,NFPRGPL_DEP,NFPRGPLX_DEP
USE YOMCT0   , ONLY : NPROC
USE YOMMP    , ONLY : MYPROC
USE YOMTAG   , ONLY : MTAGDISTGP         ,MTAGDISTGP_DEP
USE YOMFPGIND, ONLY : NFPRGPIND,NFPRGPNUM,NFPRGPIND_DEP,NFPRGPNUM_DEP

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN) :: KC
INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS
REAL(KIND=JPRB),INTENT(IN)    :: PFIELD_DEP(NFPRGPL_DEP,KFLDS)
REAL(KIND=JPRB),INTENT(OUT)   :: PFIELD_ARR(NFPRGPL,KFLDS)

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

REAL(KIND=JPRB) :: ZFIELDG(NFPRGPG,1+(KC-1)*(KFLDS-1))
INTEGER(KIND=JPIM) :: IAFPIO(KFLDS)
LOGICAL :: LLMASK(KFLDS)

INTEGER(KIND=JPIM) :: ISTRIN, JFIELD
INTEGER(KIND=JPIM) :: INFG, INFL, INFD(NPROC), IFLDOFF(NPROC)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "disgridfp.intfb.h"
#include "diwrgrfp.intfb.h"

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

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

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

!*       1. READ OR COMPUTE OUTPUT CLIMATOLOGY
!           ----------------------------------

ISTRIN=NPROC

IF (KFLDS > 0) THEN

  IAFPIO(:) = -999
  LLMASK(:) = .FALSE.
  DO JFIELD=1,KFLDS
    IAFPIO(JFIELD) = MOD(JFIELD-1,ISTRIN)+1
    LLMASK(JFIELD) = MYPROC /= IAFPIO(JFIELD)
  ENDDO

  IF (NPROC == 1) THEN
    ! Data transfers
    PFIELD_ARR(:,:)=PFIELD_DEP(:,:)
  ELSE

    IF (KC == 2) THEN

      ! One call of DIWRGRFP+DISGRIDFP for all fields.
      !  Probably more efficient than KC=1.
      !  Coding not yet complete.
      INFG=KFLDS
      INFL=0
      DO JFIELD=1,KFLDS
        IF (.NOT.LLMASK(JFIELD)) INFL=INFL+1
      ENDDO
      INFD(1:NPROC)=1 !! ky: not OK, I don't know what to put in!
      IFLDOFF(1:NPROC)=0 !! ky: not OK, I don't know what to put in!
      CALL DIWRGRFP(MTAGDISTGP_DEP,INFG,NFPRGPG,NFPRGPL_DEP,NFPRGPLX_DEP,INFL, &
       & NFPRGPIND_DEP,NFPRGPNUM_DEP,INFD,IFLDOFF, &
       & PFIELD_DEP(1:NFPRGPL_DEP,1:KFLDS),ZFIELDG(1:NFPRGPG,1:KFLDS))
      CALL DISGRIDFP(MTAGDISTGP,INFG,NFPRGPG,NFPRGPL,NFPRGPLX,INFL, &
       & NFPRGPIND,NFPRGPNUM,INFD,IFLDOFF,ZFIELDG(1:NFPRGPG,1:KFLDS), &
       & PFIELD_ARR(1:NFPRGPL,1:KFLDS))

    ELSEIF (KC == 1) THEN

      ! One call of DIWRGRFP+DISGRIDFP per field.
      INFG=1
      IFLDOFF(1:NPROC)=0
      DO JFIELD=1,KFLDS
        ! INFL is 1 when the current proc collects the DM-global array ZFIELDG,
        !  0 otherwise
        ! (if 0, DISGRIDFP only receives data, DIWRGRFP only sends data).
        IF (.NOT.LLMASK(JFIELD)) THEN
          INFL=1
        ELSE
          INFL=0
        ENDIF
        ! INFD is 1 for the proc which collects the DM-global array ZFIELDG,
        !  0 otherwise.
        INFD(1:NPROC)=0
        INFD(IAFPIO(JFIELD))=1
        CALL DIWRGRFP(MTAGDISTGP_DEP,INFG,NFPRGPG,NFPRGPL_DEP,NFPRGPLX_DEP,INFL, &
         & NFPRGPIND_DEP,NFPRGPNUM_DEP,INFD,IFLDOFF,PFIELD_DEP(1,JFIELD), &
         & ZFIELDG(1,1))
        CALL DISGRIDFP(MTAGDISTGP,INFG,NFPRGPG,NFPRGPL,NFPRGPLX,INFL, &
         & NFPRGPIND,NFPRGPNUM,INFD,IFLDOFF,ZFIELDG(1,1),&
         & PFIELD_ARR(1,JFIELD))
      ENDDO

    ENDIF

  ENDIF
ENDIF

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

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