SUBROUTINE MPOBSEQAD_UNPCK(&
 & KPROMB,KOBTYP,KOBNUM,KOBNUMA,&
 & PSLU    ,PSLV    ,PSLT    ,PSLGFL ,&
 & PSLSP   ,&
 & PSLDL   ,PSLDM   ,&
 & PSLTS   ,PSLWS   ,PSLSN   ,PSLZ0   ,PSLWL  ,&
 & PSLU10N, PSLV10N)  

!**** *MPOBSEQAD_UNPCK* Message passing of obs.eq.

!     Purpose : Exchange GOM arrays
!     ---------

!     Interface : CALL MPOBSEQAD_UNPCK(..)
!     -----------

!     Explicit arguments : 
!     -------------------- 
!                          PSLU etc. - interpolated obs eq.

!     Implicit arguments : 
!     ------------------

!     Externals :   MPL_RECV - recieve message
!     ---------     MPL_SEND - send message

!     Author : Mats Hamrud *ECMWF*
!     ------

!     Modifications :
!     -------------
!     95-12-08 M.Hamrud    : Original
!     96-12-01 M.Hamrud    : 4-D var
!     97-11-17 E.Andersson : Introduce CIW and O3, Flexible GOM-arrays.
!     99-07-08 M.Siroka    : debug ALADIN 3DVAR (treat PSLDL, PSLDM for 1 proc.)
!     00-09-01 D.Dent      : MPE to MPL conversion
!     02-08-01 Deborah Salmond  LIMP_NOOLAP Option for non-overlapping
!                            message passing and buffer packing
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      15-Feb-2005 New-style GOM arrays
!     05-12-08 N.Bormann   : Bugfix for 2d surface GOM arrays
!     04-12-09 H. Hersbach : 10-m neutral wind
!    -------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG
USE YOMCT0   , ONLY : NPROC
USE YOMCT0B  , ONLY : LECMWF
USE YOMLUN   , ONLY : NULERR   
USE YOMCOCTP , ONLY : NSYNOP   ,NAIREP   ,NSATOB   ,NDRIBU   ,&
 & NTEMP    ,NPILOT   ,NSATEM   ,NPAOB    ,NSCATT  ,&
 & NLIMB, NRADAR
USE YOMGLOBS , ONLY : &
 & NOBSRECVAD,NSTARECVAD,NTYPRECVAD,NOBSSENDAD,&
 & NSTASENDAD,NLOCSENDAD,NGLOBKEYAD,NLOCPROFAD,&  
 & RECVBUFAD,LPREMPOBS,NSTRECVTSLAD,NENRECVTSLAD  
USE YOMECTAB , ONLY : NTSLOTNO
USE YOMMP    , ONLY : MYPROC
USE GOMS_MIX , ONLY : YGOMUA,YGOMS,YGOMEC,YGOMUA_2D,YGOMS_2D,YGOMEC_2D,&
 & LGOMUA,YGOMV, &
 & NGOMGFL, LGOMGFL, MGOMGFL

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBTYP(:) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBNUM(:) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBNUMA(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLU(:,:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLV(:,:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLT(:,:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLGFL(:,:)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLSP(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLDL(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLDM(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLTS(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLWS(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLSN(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLZ0(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLWL(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLU10N(:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSLV10N(:) 

INTEGER(KIND=JPIM) :: IBP, &
 & IOBS, IOBSL,  IOFF, &
 & IOFFR, IOFFS, &
 & IRECV, &
 & ITS, &
 & ITYP, JOBS, JROC,  &
 & INUM,IPROF,JGFL,IGFL,&
 & ISTGFL, IENGFL ,ISTGF2, IENGF2

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!    -------------------------------------------------------------------
!*       0.  ZERO OBS EQ.
!            ------------

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

ITS = NTSLOTNO

!    ----------------------------------------------------------------------
!*       1.  EXCHANGE OBS.EQ. WITH OTHER PROCESSORS.
!            ---------------------------------------


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


!      UNPACK RECEIVE BUFFER
!      ---------------------

CALL GSTATS(1077,0)
!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1)&
!$OMP&PRIVATE(JROC,IRECV,IBP)
DO JROC=1,NPROC-1
  IRECV = MOD(-JROC-1+MYPROC+NPROC,NPROC)+1
  IF(NOBSRECVAD(IRECV,ITS) > 0) THEN
    IBP = NSTRECVTSLAD(ITS,IRECV)-1
    CALL UNPACK_RECV(IBP,IRECV,RECVBUFAD)
  ENDIF
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1077,1)

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

!*       2.  COPY YOUR OWN OBS.EQ. TO RECEIVE ARRAYS
!            ---------------------------------------
IOFFS = NSTASENDAD(MYPROC,ITS)
IOFFR = NSTARECVAD(MYPROC,ITS)
CALL GSTATS(1079,0)
!$OMP PARALLEL DO SCHEDULE(STATIC)&
!$OMP&PRIVATE(JOBS,IOBSL,IOBS,IPROF,INUM,JGFL,IGFL,ISTGFL,IENGFL)
DO JOBS=1,NOBSSENDAD(MYPROC,ITS)
  IOBSL = NGLOBKEYAD(IOFFR+JOBS)
  IOBS  = NLOCSENDAD(IOFFS+JOBS)
  IPROF = NLOCPROFAD(IOFFS+JOBS)
  INUM = KOBNUM(IOBS)
  IF(IPROF == 0) THEN
    IF(INUM /= YGOMUA(INUM)%IOBS) THEN
      WRITE(NULERR,*) 'MPOBSEQAD_UNPCK - INUM /= YGOMUA(INUM)%IOBS 2',&
       & MYPROC,JOBS,INUM,YGOMUA(INUM)%IOBS
      CALL ABOR1('MPOBSEQAD_UNPCK - INUM /= YGOMUA(INUM)%IOBS 2')
    ENDIF
    IF(YGOMUA(INUM)%LU) PSLU(:,IOBSL) = YGOMUA(INUM)%U(:)
    IF(YGOMUA(INUM)%LV) PSLV(:,IOBSL) = YGOMUA(INUM)%V(:) 
    IF(YGOMUA(INUM)%LT) PSLT(:,IOBSL) = YGOMUA(INUM)%T(:)
    IGFL = 0
    DO JGFL=1,NGOMGFL
      IF(YGOMUA(INUM)%LGFL(JGFL)) THEN
        IGFL = IGFL+1
        ISTGFL = 1+(IGFL-1)*NFLEVG
        IENGFL = ISTGFL+NFLEVG-1
        ISTGF2 = 1+(JGFL-1)*NFLEVG
        IENGF2 = ISTGF2+NFLEVG-1
        PSLGFL(ISTGF2:IENGF2,IOBSL) = YGOMUA(INUM)%GFL(ISTGFL:IENGFL)
      ENDIF
    ENDDO
  ELSE
    IF(INUM /= YGOMUA_2D(INUM)%IOBS) THEN
      WRITE(NULERR,*) 'MPOBSEQAD_UNPCK - INUM /= YGOMUA_2D(INUM)%IOBS 3',&
       & MYPROC,JOBS,INUM,YGOMUA_2D(INUM)%IOBS
      CALL ABOR1('MPOBSEQAD_UNPCK - INUM /= YGOMUA(INUM)%IOBS 3')
    ENDIF
    IF(YGOMUA_2D(INUM)%LU) PSLU(:,IOBSL) = YGOMUA_2D(INUM)%U(:,IPROF)
    IF(YGOMUA_2D(INUM)%LV) PSLV(:,IOBSL) = YGOMUA_2D(INUM)%V(:,IPROF)
    IF(YGOMUA_2D(INUM)%LT) PSLT(:,IOBSL) = YGOMUA_2D(INUM)%T(:,IPROF)
    IGFL = 0
    DO JGFL=1,NGOMGFL
      IF(YGOMUA_2D(INUM)%LGFL(JGFL)) THEN
        IGFL = IGFL+1
        ISTGFL = 1+(IGFL-1)*NFLEVG
        IENGFL = ISTGFL+NFLEVG-1
        ISTGF2 = 1+(JGFL-1)*NFLEVG
        IENGF2 = ISTGF2+NFLEVG-1
        PSLGFL(ISTGF2:IENGF2,IOBSL) = YGOMUA_2D(INUM)%GFL(ISTGFL:IENGFL,IPROF)
      ENDIF
    ENDDO
  ENDIF
ENDDO
!$OMP END PARALLEL DO
!OCL NOVREC
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JOBS,IOBSL,IOBS,IPROF,ITYP,INUM)
DO JOBS=1,NOBSSENDAD(MYPROC,ITS)
  IOBSL = NGLOBKEYAD(IOFFR+JOBS)
  IOBS  = NLOCSENDAD(IOFFS+JOBS)
  IPROF = NLOCPROFAD(IOFFS+JOBS)
  ITYP = KOBTYP(IOBS)
  INUM = KOBNUM(IOBS)
  IF(IPROF ==  0) THEN
    PSLSP(IOBSL) = YGOMS(INUM)%SP
    PSLTS(IOBSL) = YGOMS(INUM)%TS
    PSLZ0(IOBSL) = YGOMS(INUM)%Z0
    PSLU10N(IOBSL)=YGOMS(INUM)%U10N
    PSLV10N(IOBSL)=YGOMS(INUM)%V10N
    IF (ITYP == NSATEM) THEN
      IF(.NOT.LGOMUA(ITYP,YGOMV%MU)) PSLU (NFLEVG,IOBSL) = YGOMS(INUM)%UL
      IF(.NOT.LGOMUA(ITYP,YGOMV%MV)) PSLV (NFLEVG,IOBSL) = YGOMS(INUM)%VL
      PSLWS(IOBSL) = YGOMS(INUM)%WS
      PSLSN(IOBSL) = YGOMS(INUM)%SN
      PSLWL(IOBSL) = YGOMS(INUM)%WL
    ELSEIF (ITYP == NSCATT) THEN
      PSLU (NFLEVG,IOBSL) = YGOMS(INUM)%UL
      PSLV (NFLEVG,IOBSL) = YGOMS(INUM)%VL
      PSLT (NFLEVG,IOBSL) = YGOMS(INUM)%TL
      PSLGFL (MGOMGFL(YGOMV%MQ)*NFLEVG,IOBSL) = YGOMS(INUM)%QL
    ELSE
      PSLWS(IOBSL) = YGOMS(INUM)%WS
      PSLSN(IOBSL) = YGOMS(INUM)%SN
      PSLWL(IOBSL) = YGOMS(INUM)%WL
    ENDIF
    PSLDL(IOBSL) = YGOMEC(INUM)%ECDL
    PSLDM(IOBSL) = YGOMEC(INUM)%ECDM
  ELSE
    PSLSP(IOBSL) = YGOMS_2D(INUM)%SP(IPROF)
    PSLTS(IOBSL) = YGOMS_2D(INUM)%TS(IPROF)
    PSLZ0(IOBSL) = YGOMS_2D(INUM)%Z0(IPROF)
    PSLU10N(IOBSL)=YGOMS_2D(INUM)%U10N(IPROF)
    PSLV10N(IOBSL)=YGOMS_2D(INUM)%V10N(IPROF)
    IF (ITYP == NSATEM) THEN
      IF(.NOT.LGOMUA(ITYP,YGOMV%MU)) PSLU (NFLEVG,IOBSL) = YGOMS_2D(INUM)%UL(IPROF)
      IF(.NOT.LGOMUA(ITYP,YGOMV%MV)) PSLV (NFLEVG,IOBSL) = YGOMS_2D(INUM)%VL(IPROF)
      PSLWS(IOBSL) = YGOMS_2D(INUM)%WS(IPROF)
      PSLSN(IOBSL) = YGOMS_2D(INUM)%SN(IPROF)
      PSLWL(IOBSL) = YGOMS_2D(INUM)%WL(IPROF)
    ELSEIF (ITYP == NSCATT) THEN
      PSLU (NFLEVG,IOBSL) = YGOMS_2D(INUM)%UL(IPROF)
      PSLV (NFLEVG,IOBSL) = YGOMS_2D(INUM)%VL(IPROF)
      PSLT (NFLEVG,IOBSL) = YGOMS_2D(INUM)%TL(IPROF)
      PSLGFL (MGOMGFL(YGOMV%MQ)*NFLEVG,IOBSL) = YGOMS_2D(INUM)%QL(IPROF)
    ELSE
      PSLWS(IOBSL) = YGOMS_2D(INUM)%WS(IPROF)
      PSLSN(IOBSL) = YGOMS_2D(INUM)%SN(IPROF)
      PSLWL(IOBSL) = YGOMS_2D(INUM)%WL(IPROF)
    ENDIF
    PSLDL(IOBSL) = YGOMEC_2D(INUM)%ECDL(IPROF)
    PSLDM(IOBSL) = YGOMEC_2D(INUM)%ECDM(IPROF)

    PSLSP(IOBSL) = YGOMS_2D(INUM)%SP(IPROF)
    PSLTS(IOBSL) = YGOMS_2D(INUM)%TS(IPROF)
    PSLZ0(IOBSL) = YGOMS_2D(INUM)%Z0(IPROF)
    PSLU10N(IOBSL)=YGOMS_2D(INUM)%U10N(IPROF)
    PSLV10N(IOBSL)=YGOMS_2D(INUM)%V10N(IPROF)
    IF (ITYP == NSATEM) THEN
      IF(.NOT.LGOMUA(ITYP,YGOMV%MU)) PSLU (NFLEVG,IOBSL) = YGOMS_2D(INUM)%UL(IPROF)
      IF(.NOT.LGOMUA(ITYP,YGOMV%MV)) PSLV (NFLEVG,IOBSL) = YGOMS_2D(INUM)%VL(IPROF)
      PSLWS(IOBSL) = YGOMS_2D(INUM)%WS(IPROF)
      PSLSN(IOBSL) = YGOMS_2D(INUM)%SN(IPROF)
      PSLWL(IOBSL) = YGOMS_2D(INUM)%WL(IPROF)
    ELSEIF (ITYP == NSCATT) THEN
      PSLU (NFLEVG,IOBSL) = YGOMS_2D(INUM)%UL(IPROF)
      PSLV (NFLEVG,IOBSL) = YGOMS_2D(INUM)%VL(IPROF)
      PSLT (NFLEVG,IOBSL) = YGOMS_2D(INUM)%TL(IPROF)
      PSLGFL (MGOMGFL(YGOMV%MQ)*NFLEVG,IOBSL) = YGOMS_2D(INUM)%QL(IPROF)
    ELSE
      PSLWS(IOBSL) = YGOMS_2D(INUM)%WS(IPROF)
      PSLSN(IOBSL) = YGOMS_2D(INUM)%SN(IPROF)
      PSLWL(IOBSL) = YGOMS_2D(INUM)%WL(IPROF)
    ENDIF
    PSLDL(IOBSL) = YGOMEC_2D(INUM)%ECDL(IPROF)
    PSLDM(IOBSL) = YGOMEC_2D(INUM)%ECDM(IPROF)


  ENDIF
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1079,1)

!    ------------------------------------------------------------------
IF(.NOT.LPREMPOBS) THEN
  DEALLOCATE(RECVBUFAD)
ENDIF
!    -------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MPOBSEQAD_UNPCK',1,ZHOOK_HANDLE)
CONTAINS

SUBROUTINE UNPACK_RECV(KBP,KRECV,PBUFR)
INTEGER(KIND=JPIM),INTENT(INOUT) :: KBP
INTEGER(KIND=JPIM),INTENT(IN)    :: KRECV
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBUFR(:)

INTEGER(KIND=JPIM) :: IOFF,IOBS,ITYP,JOBS,INUM,JGFL,JLEV
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('MPOBSEQAD_UNPCK:UNPACK_RECV',0,ZHOOK_HANDLE)
IOFF = NSTARECVAD(KRECV,ITS)
DO JOBS = 1,NOBSRECVAD(KRECV,ITS)
  IOBS = NGLOBKEYAD(IOFF+JOBS)
  ITYP = MOD(NTYPRECVAD(IOFF+JOBS),100)
  
!            Copy model variables 
  IF(LGOMUA(ITYP,YGOMV%MU)) THEN
    DO JLEV=1,NFLEVG
      PSLU(JLEV,IOBS) = PBUFR(KBP+JLEV)
    ENDDO
    KBP = KBP+NFLEVG
  ENDIF
    
  IF(LGOMUA(ITYP,YGOMV%MV)) THEN
    DO JLEV=1,NFLEVG
      PSLV(JLEV,IOBS) = PBUFR(KBP+JLEV)
    ENDDO
    KBP = KBP+NFLEVG
  ENDIF
  IF(LGOMUA(ITYP,YGOMV%MT)) THEN
    DO JLEV=1,NFLEVG
      PSLT(JLEV,IOBS) = PBUFR(KBP+JLEV)
    ENDDO
    KBP = KBP+NFLEVG
  ENDIF
  DO JGFL=1,NGOMGFL
    IF(LGOMGFL(ITYP,JGFL)) THEN
      DO JLEV=1,NFLEVG
        PSLGFL((JGFL-1)*NFLEVG+JLEV,IOBS) = PBUFR(KBP+JLEV)
      ENDDO
      KBP = KBP+NFLEVG
    ENDIF
  ENDDO

  IF (ITYP == NSATEM) THEN
    IF(.NOT.LGOMUA(ITYP,YGOMV%MU)) PSLU (NFLEVG,IOBS) = PBUFR(KBP+1)
    IF(.NOT.LGOMUA(ITYP,YGOMV%MV)) PSLV (NFLEVG,IOBS) = PBUFR(KBP+2)
    PSLSP(IOBS)        = PBUFR(KBP+3)
    PSLTS(IOBS)        = PBUFR(KBP+4)
    PSLWS(IOBS)        = PBUFR(KBP+5)
    PSLSN(IOBS)        = PBUFR(KBP+6)
    PSLZ0(IOBS)        = PBUFR(KBP+7)
    PSLWL(IOBS)        = PBUFR(KBP+8)
    PSLU10N(IOBS)      = PBUFR(KBP+11)
    PSLV10N(IOBS)      = PBUFR(KBP+12)
  ELSEIF (ITYP == NSCATT) THEN
    !            Copy model variables for Scatterometer obs operators
    PSLU (NFLEVG,IOBS) = PBUFR(KBP+1)
    PSLV (NFLEVG,IOBS) = PBUFR(KBP+2)
    PSLSP(IOBS)        = PBUFR(KBP+3)
    PSLTS(IOBS)        = PBUFR(KBP+4)
    PSLZ0(IOBS)        = PBUFR(KBP+7)
    PSLT (NFLEVG,IOBS) = PBUFR(KBP+9)
    PSLU10N(IOBS)      = PBUFR(KBP+11)
    PSLV10N(IOBS)      = PBUFR(KBP+12)
    PSLGFL (MGOMGFL(YGOMV%MQ)*NFLEVG,IOBS) = PBUFR(KBP+10)
  ELSEIF (ITYP == NSYNOP .OR. ITYP == NAIREP .OR.&
   & ITYP == NSATOB .OR. ITYP == NDRIBU .OR.&
   & ITYP == NTEMP  .OR. ITYP == NPILOT .OR.&
   & ITYP == NPAOB  .OR. ITYP == NLIMB .OR. ITYP == NRADAR) THEN  

    !            Copy model variables for conventional obs operators

    PSLSP(IOBS) = PBUFR(KBP+3)
    PSLTS(IOBS) = PBUFR(KBP+4)
    PSLWS(IOBS) = PBUFR(KBP+5)
    PSLSN(IOBS) = PBUFR(KBP+6)
    PSLZ0(IOBS) = PBUFR(KBP+7)
    PSLWL(IOBS) = PBUFR(KBP+8)
    PSLU10N(IOBS)=PBUFR(KBP+11)
    PSLV10N(IOBS)=PBUFR(KBP+12)
  ELSE
    WRITE(NULERR,'(A,3I8)') ' MPOBSEQAD_UNPCK:UNKNOWN OBS TYPE',&
     & JOBS,IOBS,ITYP  
    CALL ABOR1('MPOBSEQAD_UNPCK:UNKNOWN OBS TYPE')
  ENDIF
  KBP = KBP+12
  PSLDL(IOBS) = PBUFR(KBP+1)
  PSLDM(IOBS) = PBUFR(KBP+2)
  KBP = KBP+2
  
ENDDO

IF(LECMWF .AND. KBP /= NENRECVTSLAD(ITS,KRECV)) THEN
  WRITE(NULERR,*)'MYPROC,KRECV,KBP,ITS,NENRECVTSLAD(ITS,KRECV) ',&
   & MYPROC,KRECV,KBP,ITS,NENRECVTSLAD(ITS,KRECV)
  CALL ABOR1(' MPOBSEQAD_UNPCK: KBP /= NENRECVTSLAD(ITS,KRECV) ')
ENDIF
IF (LHOOK) CALL DR_HOOK('MPOBSEQAD_UNPCK:UNPACK_RECV',1,ZHOOK_HANDLE)

END SUBROUTINE UNPACK_RECV


END SUBROUTINE MPOBSEQAD_UNPCK
