SUBROUTINE OSCATIN  (KSCATP,&
 & KOBTYP,KCDTYP,KOBSQNO,KCDSQNO,&
 & LDMESAGE,LDTAKEN)  

!**** SUBROUTINE OSCATIN - PROCESS INPUT SCATTEROMETERS

!        HANS HERSBACH  ECMWF  28/09/09 

!     PURPOSE
!     -------

!        PROCESS INPUT OCEANSAT-2 SCATTEROMETER

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

!        CALL OSCATIN  (KSCATP,
!                     KOBTYP,KCDTYP,KOBSQNO,KCDSQNO,
!                     LDMESAGE,LDTAKEN)

!     WHERE:
!            KSCATP   = SCAT REP POINTER

!        OSCATIN IS CALLED BY SUBROUTINE SCAT_OB

!     METHOD
!     ------

!        THE CMA SCAT. RECORD IS BUILT UP FROM THE EXPANDED BUFR ARRAYS.
!        ORIGINAL FROM QSCATIN TEMPLATE

!     EXTERNALS
!     ---------

!        PRLMCHK  - PRELIMINARY CHECKS
!        GETSETE  - GET/SET BODY ENTRY
!        FILFBDE  - UPDATE  BODY ENTRY
!        ERRSTAT  - OBS. ERROR
!        PPVAFL   - PRESSURE/VARIABLE FLAG RESET
!        OBINSTP  - INTSTRUMENT TYPE
!        OBSCHAR  - OBS. CHARACTERISTICS

!     MODIFICATIONS
!     -------------

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE PARERSCA
USE YOMCOSJO , ONLY : ROERR_OSCAT
USE YOMDB
USE YOMVNMB  , ONLY : NVNUMB
USE YOMANCS  , ONLY : NMDI ,RMDI ,RDEGREES ,RADIANS,RUPMLIM,RDWMLIM, &
                    & EPSMAC,RTICE,RTWAT,R2ES,R3LES,R3IES,R4LES,R4IES,RTT
USE YOMNMCOD , ONLY : NSCACVC
USE YOMCMBDY , ONLY : NCMBVFBP ,NCMBFLBP ,NCMBFLOC
USE YOMMKODB , ONLY : NMKCMVSE ,LTOTREM 
USE YOMNMEV  , ONLY : ND1EVENT
USE YOMCST   , ONLY : RPI
USE YOMLUN   , ONLY : NULOUT
USE LOCAL_TRAFOS, ONLY : UCOM, VCOM

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSCATP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBTYP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCDTYP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBSQNO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCDSQNO 
LOGICAL           ,INTENT(INOUT) :: LDMESAGE 
LOGICAL           ,INTENT(OUT)   :: LDTAKEN 

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

REAL(KIND=JPRB)    , ALLOCATABLE :: ZROBODY(:,:), ZSATBODY(:,:)
INTEGER(KIND=JPIM) , ALLOCATABLE :: IBODY  (:,:), IORDER(:)

REAL(KIND=JPRB) ::&
 &  ZFF(JPBRNSWI), ZDD(JPBRNSWI), ZUU(JPBRNSWI),ZVV(JPBRNSWI),&
 &  ZMLE(JPBRNSWI)
INTEGER(KIND=JPIM) :: IWSORT(JPBRNSWI), IFF(JPBRNSWI), IDD(JPBRNSWI)

INTEGER(KIND=JPIM), PARAMETER :: IVAR=4
INTEGER(KIND=JPIM)            ::&
 &  JVAR(0:IVAR),JVARMAX(0:IVAR),JVARNUM(0:IVAR),JVNM(0:IVAR)

INTEGER(KIND=JPIM) :: INBODY, IVNM,&
 & IOBDATE,IOBTIME, ISTID, &
 & INSTYP, ISCHAN, ISINS, ISDPT, &
 & IREPST, ISATID, ICELLNO

INTEGER(KIND=JPIM) :: JALL, IALL, IV,JV,IH,&
 & INDXU,INDXV,INDXD,INDXF,IWIND,IAMB,JAMB,&
 & IAUSTAT, IAUEVEN1, IAUEVEN2, IAURDBFL, IAUANFLG, &
 & IAUPFLG, IAUFLG  , IAUVERCO  

LOGICAL :: LLACCEPT, LLRESORT, LLFAIL, LLREMOVE,  LLUNKNOWN

CHARACTER (LEN = 8) :: CLSTID

REAL(KIND=JPRB) :: ZDIRSKI, ZWE, ZLAT, ZLON, ZTIMDIF&
 &                ,ZLARGEST,ZDIR1,ZDIR2,ZDEL

REAL(KIND=JPRB) :: ZAU, ZAUPRES, ZAUPRL, &
 & ZAUPERR, ZAUOERR, ZAUFERR, ZAURERR, &
 & ZAUFGER, ZAUFGCC1, ZAUFGCC2, &
 & ZAUFGDEP, ZAUANDEP  

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "finoerr.intfb.h"
#include "filfbde.intfb.h"
#include "getsete.intfb.h"
#include "obinstp.intfb.h"
#include "ppvafl.intfb.h"
#include "prlmchk.intfb.h"

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

#include "fcobs.h"

#include "stmfun_ifs.h"

#include "openmp_obs.h"

!*
!        1.             PRESET
!                       ------

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

LLRESORT = .true.

!*           REST   AMBIG U ,AMBIG V ,DD      ,FF
JVAR     = (/NMDI  ,62      ,61      ,48      ,49      /)
JVARMAX  = (/0     ,JPBRNSWI,JPBRNSWI,JPBRNSWI,JPBRNSWI/)

JVNM(0)=0
DO IV=1, IVAR
   JVNM(IV)=NVNUMB(JVAR(IV))
ENDDO

!*
!-----------------------------------------------------------------------

!        2.             GENERAL OBSERVATION INFO.
!                       -------------------------
!*          2.1         GET OBS. PARAMETERS FROM ODB HEADER

ZLAT   = ROBHDR(KSCATP,MDBLAT) * RDEGREES
ZLON   = ROBHDR(KSCATP,MDBLON) * RDEGREES
IOBDATE= ROBHDR(KSCATP,MDBDAT)
IOBTIME= ROBHDR(KSCATP,MDBETM)
CLSTID = TRANSFER(ROBHDR(KSCATP,MDBSID), CLSTID)
ISTID  = 0
READ(CLSTID(1:8),'(A8)') ISTID
IREPST = ROBHDR(KSCATP,MDBRST)


!*          2.2         DEFINE INSTRUMENT TYPE

INSTYP  = 0
ISCHAN  = NMDI
ISINS   = NMDI
ISDPT   = NMDI
CALL OBINSTP(ZLAT,ZLON,ISTID,&
 & KOBTYP,KCDTYP,&
 & INSTYP)  

!*          2.3         SET INSTRUMENT TYPE INTO OBSERVATION
!                       CHARACTERISTICS

IF (ROBHDR(KSCATP,MDB_INSTTYPE_AT_HDR) == 0._JPRB) ROBHDR(KSCATP,MDB_INSTTYPE_AT_HDR) = INSTYP

!*
!-----------------------------------------------------------------------

!        3.             PRELIMINARY CHECKS
!                       ------------------

!*          3.1         REPORT PARAMETERS

LLFAIL   = .FALSE.
LLREMOVE = .FALSE.
CALL PRLMCHK(KOBTYP,KCDTYP,ZLAT,ZLON,IOBDATE,IOBTIME,IREPST,ZTIMDIF,&
 & LDMESAGE,LLFAIL,LLREMOVE)  

!*          3.1.0       UPDATE REPORT STATUS

ROBHDR(KSCATP,MDBRST) = IREPST

!*          3.1.1       FAILED/REMOVED REPORT

IF(LLFAIL .OR. LLREMOVE  ) THEN
  IF(LTOTREM) THEN
     IF(LDMESAGE)           THEN
        WRITE(NULOUT,'('' LAT.     :'',F10.2)') ZLAT
        WRITE(NULOUT,'('' LON.     :'',F10.2)') ZLON
        CALL FLUSH(NULOUT)
     ENDIF
!*        3.1.2         PREMATURE EXIT FROM ROUTINE
     IF (LHOOK) CALL DR_HOOK('OSCATIN',1,ZHOOK_HANDLE)
     RETURN
  ENDIF
ENDIF

!*          3.2.1       SATHDR

!*          3.2.1.1     SAT ID

ISATID   = SATHDR(KSCATP,MDB_SATID_AT_SAT)

!*          3.2.1.2     NUMBER OF AMBIGUITIES

IAMB     = SATHDR(KSCATP,MDB_NRETR_AMB)

!*          3.2.1.3     CELL NO.

ICELLNO  = SATHDR(KSCATP,MDBSCCNO)


LLACCEPT = .TRUE.

!*          3.2.3       CHECK WIND VECTOR CELL NUMBER

IF(ICELLNO < 1 .OR. ICELLNO > JPICELL )  THEN
   WRITE(NULOUT,'(''0OSCATIN; CELL NO. OUT OF RANGE;'',&
    & '' HENCE REPORT NOT CREATED'')')
   WRITE(NULOUT,'('' ICELLNO: '',I10)') ICELLNO
   LDMESAGE = .TRUE.
   LLACCEPT = .FALSE.
ENDIF

!*          3.2.4       NUMBER OF AMBIGUITIES

IF(IAMB < 0 .OR. IAMB > JPBRNSWI )  THEN
   WRITE(NULOUT,'(''0OSCATIN; NUM AMBIGUITIES OUT OF RANGE;'',&
    & '' HENCE REPORT NOT CREATED'')')
   WRITE(NULOUT,'(''          IAMB  : '',I10)') IAMB
   LDMESAGE = .TRUE.
   LLACCEPT = .FALSE.
ENDIF


IF(.NOT. LLACCEPT ) THEN
   WRITE(NULOUT,'('' OSCATIN, NOT ACCEPTED DATUM AT: ZLAT, ZLON: '',2(F10.2,1X))') ZLAT, ZLON
   CALL FLUSH(NULOUT)
   IF (LHOOK) CALL DR_HOOK('OSCATIN',1,ZHOOK_HANDLE)
   RETURN
ENDIF

!*
!-----------------------------------------------------------------------

!*          3.3         CHECK BODY/SCATT_BODY PARAMETERS

!*          3.3.1       INITIALIZATION

JVARNUM(:)=0

ZDD (:) = RMDI
ZFF (:) = RMDI
ZUU (:) = RMDI
ZVV (:) = RMDI
ZMLE(:) = RMDI

!*          3.3.2       LOOP OVER ALL BODIES
CHECK_BODIES: DO JALL = MLNKH2B(KSCATP),MLNKH2B(KSCATP+1)-1

  IVNM = ROBODY(JALL,MDBVNM)
  LLUNKNOWN=.TRUE.
  IV=0
  DO IH=1,IVAR
     IF(IVNM == JVNM(IH)) THEN
       IV=IH
       LLUNKNOWN=.FALSE.
       JVARNUM(IH)=JVARNUM(IH)+1
     ENDIF
  ENDDO
  IF(LLUNKNOWN) THEN 
     LDMESAGE = .TRUE.
     WRITE(NULOUT,'('' OSCATIN  ; UNEXPECTED VARIABLE: '',I10)') IVNM
  ENDIF

!*          3.3.3       GET OSCAT DD AND FF

  JV=JVARNUM(IV)
  IF(IVNM == NVNUMB( 48) .AND. JV <= JPBRNSWI) THEN
     ZDD(JV)=ROBODY (JALL,MDBVAR)
     IDD(JV)=IBITS(INT(ROBODY(JALL,MDBRDFL)),NCMBVFBP+NCMBFLBP,NCMBFLOC)
  ENDIF

  IF(IVNM == NVNUMB( 49) .AND. JV <= JPBRNSWI) THEN
     ZFF (JV)=ROBODY (JALL,MDBVAR)
     IFF(JV)=IBITS(INT(ROBODY(JALL,MDBRDFL)),NCMBVFBP+NCMBFLBP,NCMBFLOC)
     ZMLE(JV)=SATBODY(JALL,MDBSCRES)
  ENDIF

!*          3.3.4       CLOSE THE LOOP
ENDDO CHECK_BODIES

!*          3.3.6       WE REQUIRE: 4 AMBIG U, 4 ABIG V, 4 DD, 4 FF

IF( MINVAL(JVARNUM-JVARMAX) < 0) THEN
   WRITE(NULOUT,'('' ERROR IN SUBROUTINE OSCATIN; '')')
   WRITE(NULOUT,'('' INSUFFICIENT NUMBER OF BODIES; '')')
   DO IV=1,IVAR
      WRITE(NULOUT,'('' IV,JVARNUM,JVARMAX : '',3(I2,1X))')&
       & IV,JVARNUM(IV),JVARMAX(IV)
   ENDDO
   CALL ABOR1(' OSCATIN : ')
ENDIF


!*
!-----------------------------------------------------------------------

!        4.             WIND RETRIEVAL
!                       --------------

!*          4.1           TRANSFORM OSCAT (FF,DD) --> OSCAT (UU,VV) 
DO IWIND=1, JPBRNSWI
    IWSORT(IWIND) = IWIND

    IF(ZDD(IWIND) == RMDI) CYCLE
    IF(ZFF(IWIND) == RMDI) CYCLE

    ZUU(IWIND) = UCOM(ZDD(IWIND),ZFF(IWIND))
    ZVV(IWIND) = VCOM(ZDD(IWIND),ZFF(IWIND))
ENDDO

!*          4.2           COMPONENT WIND ERROR 
ZWE=ROERR_OSCAT(ICELLNO)

ZDIRSKI = RMDI ! directional error skill to missing value


!*          4.3           REORDER WINDS BY MLE AND DIRECTION
!                         To make better use of the ambiguities in IFS
!                         order by MLE 
!                         (not the brightest algorithm, but it works)

!*          4.3.1       FIND AMBIGUITY WITH HIGHEST MLE
IF (IAMB >= 1) THEN
   ZLARGEST = RMDI
   DO JAMB = 1 , IAMB
      IF(ZMLE(JAMB) > ZLARGEST) THEN
         ZLARGEST = ZMLE(JAMB)
         IWSORT(1)= JAMB
       ENDIF
   ENDDO
ENDIF

!*          4.3.2       FIND AMBIGUITY WHICH OPPOSES THE FIRST
!*                      BY 180 DEGRESS (OR CLOSEST TO 180)
IF (IAMB >= 2) THEN
   ZLARGEST = RMDI
   ZDIR1    = ZDD(IWSORT(1))*RADIANS
   DO JAMB = 1 , IAMB
      IF(JAMB == IWSORT(1)) CYCLE
      ZDIR2 = ZDD(JAMB)*RADIANS
      ZDEL  = RPI - ABS(RPI - ABS(ZDIR1 - ZDIR2))
      IF(ZDEL > ZLARGEST)  THEN
         ZLARGEST = ZDEL
         IWSORT(2)= JAMB
       ENDIF
   ENDDO
ENDIF

!*          4.3.3       DETERMINE HIGHEST MLE OF THIRD AMBIGUITY
IF(IAMB >= 3) THEN
   ZLARGEST = RMDI
   DO JAMB = 1 , IAMB
      IF(JAMB == IWSORT(1)) CYCLE
      IF(JAMB == IWSORT(2)) CYCLE
      IF(ZMLE(JAMB) > ZLARGEST) THEN
         ZLARGEST = ZMLE(JAMB)
         IWSORT(3)= JAMB
       ENDIF
   ENDDO
ENDIF

!*          4.2.4       FILL IN FOURTH AMBIGUITY, IF PRESENT
IF(IAMB == 4) THEN
   DO JAMB = 1 , IAMB
      IF(JAMB == IWSORT(1)) CYCLE
      IF(JAMB == IWSORT(2)) CYCLE
      IF(JAMB == IWSORT(3)) CYCLE
      IWSORT(4)=JAMB
   ENDDO
ENDIF

!*        4.2.5         CHECK VALIDITY OF SORTING
LLACCEPT = .TRUE.   

IF ( MINVAL(IWSORT) < 1        )    LLACCEPT=.FALSE.  !* RANGE?
IF ( MAXVAL(IWSORT) > JPBRNSWI )    LLACCEPT=.FALSE.
DO IWIND=1, JPBRNSWI
   DO JAMB=1,IWIND-1                                  !* ALL DIFFERENT?
      IF (IWSORT(JAMB) == IWSORT(IWIND)) LLACCEPT=.FALSE. 
   ENDDO
ENDDO

IF(.NOT. LLACCEPT) THEN
    WRITE(NULOUT,'('' OSCATIN ERROR: AMBIGUITIES NOT WELL REORDERED '')')
    WRITE(NULOUT,*)'IWSORT: ',IWSORT(:)
    CALL FLUSH(NULOUT)
    CALL ABOR1(' OSCATIN : ')
ENDIF


!*
!-----------------------------------------------------------------------

!        5.             MODIFY SATHEADER
!                       -----------------

!*
!-----------------------------------------------------------------------

!        6.             UPDATE BODY/SCATT_BODY ELEMENTS
!                       -------------------------------

!*          6.1         ALLOCATION/INITIALIZATION

INBODY=MLNKH2B(KSCATP+1)-MLNKH2B(KSCATP)
IF(INBODY <= 0) THEN
  IF (LHOOK) CALL DR_HOOK('OSCATIN',1,ZHOOK_HANDLE)
  RETURN
ENDIF

ALLOCATE(IBODY(0:IVAR,INBODY))
IBODY(:,:) = 0
JVARNUM(:) = 0

!*          6.2         LOOP OVER BODY ELEMENTS
UPDATE_BODIES: DO JALL = MLNKH2B(KSCATP),MLNKH2B(KSCATP+1)-1

!*          6.3         CHECK ON BUFR MISSING INDICATOR

!*          6.4.1       PRESSURE
   IF( (ROBODY(JALL ,MDBPPP) <= RUPMLIM)   .AND. &
   &   (ROBODY(JALL ,MDBPPP) >= RDWMLIM) ) ROBODY(JALL ,MDBPPP ) = RMDI

!*          6.3.2       VARIABLE
   IF( (ROBODY(JALL ,MDBVAR) <= RUPMLIM)   .AND. &
   &   (ROBODY(JALL ,MDBVAR) >= RDWMLIM) ) ROBODY(JALL ,MDBVAR ) = RMDI


!*          6.4         PRESET/GET LOCAL COPY FROM ODB BODY
!*                      OBS VALUE, PRESSURES, ERRORS, DEPATURES ARE PRESET TO RMDI
   CALL GETSETE(JALL ,&
    & ZAUPRES,ZAUPRL,ZAU ,&
    & ZAUFGER,ZAUFGCC1,ZAUFGCC2,&
    & ZAUPERR,ZAUOERR,ZAUFERR,ZAURERR,&
    & ZAUFGDEP,ZAUANDEP,&
    & IAUSTAT,IAUEVEN1,IAUEVEN2,IAURDBFL,IAUANFLG,&
    & IAUFLG,IAUPFLG)  

   ZAUPRES = ROBODY(JALL,MDBPPP)     !* OVERWRITE PRESETED VALUE RMDI
   ZAU     = ROBODY(JALL,MDBVAR)     !* OVERWRITE PRESETED VALUE RMDI

   IVNM    = ROBODY(JALL,MDBVNM)
   IAUVERCO= ROBODY(JALL,MDBVCO)

!*          6.6         CHECK OBSERVATION IDENTITY
   IV=0
   DO IH=1,IVAR
      IF((IVNM == JVNM(IH)).AND.(JVARNUM(IH) < JVARMAX(IH))) IV=IH
   ENDDO
   JVARNUM(IV)=JVARNUM(IV)+1
   IBODY(IV,JVARNUM(IV))=JALL

!*          6.7         UPDATE BODY/SCATT_BODY FOR WIND

   IF((JVAR(IV) == 62) .OR. (JVAR(IV) == 61) .OR. &    ! AMB WIND
   &  (JVAR(IV) == 48) .OR. (JVAR(IV) == 49) ) THEN    ! UWI DD AND FF

      IWIND=JVARNUM(IV)
      IF (JVAR(IV) == 62) ZAU=ZUU(IWIND) ! AMBIG U
      IF (JVAR(IV) == 61) ZAU=ZVV(IWIND) ! AMBIG V

      SATBODY(JALL,MDBSCRES) = ZMLE(IWIND)
      SATBODY(JALL,MDBSCDIS) = ZDIRSKI

!*         6.8          ERRORS
      IF( (JVAR(IV) == 62) .OR. (JVAR(IV) == 61) &
      &                    .OR. (JVAR(IV) == 49) ) ZAUOERR = ZWE

      CALL FINOERR(ZAUPERR,ZAUOERR,ZAUFERR)
      IAUVERCO = NSCACVC

!*          6.9         VERTICAL LEVEL ACCORDING TO MLE-SORTED WINDS
      DO IAMB=1,JPBRNSWI
         IF (IWSORT(IAMB) == IWIND)  ZAUPRES = IAMB
      ENDDO
   ENDIF

!*          6.10        STATUS, EVENTS, FLAGS
   IF(ZAU == RMDI) THEN
      IAUSTAT=ICHSTAT_REJECT(IAUSTAT)
   ENDIF

   IF(IV == 0) THEN
      IAUSTAT = ICHSTAT_REJECT( IAUSTAT )
      IAUEVEN1=ICHEV1(IAUEVEN1,ND1EVENT(17))
   ELSE
      IF(NMKCMVSE(JVAR(IV),KCDSQNO,KOBSQNO) == 0) THEN
         IAUSTAT = ICHSTAT_REJECT( IAUSTAT )
      ENDIF
   ENDIF

   IF( (JVAR(IV) == 62) .OR. (JVAR(IV) == 61) ) THEN
      IWIND=JVARNUM(IV)
      IAUFLG=MAX(IDD(IWIND),IFF(IWIND))
   ENDIF
   CALL PPVAFL(IAUPFLG,IAUFLG,IAURDBFL)

!*          6.11        DEPARTURES

!*          6.12        PUT UPDATED BODY ELEMENT BACK IN ODB
   CALL FILFBDE(JALL ,IVNM   ,IAUVERCO ,&
    & ZAUPRES ,ZAUPRL,ZAU ,&
    & ZAUFERR ,ZAUOERR ,ZAURERR ,ZAUPERR,&             !* NOTE DIFFERENCE IN ORDER
    & ZAUFGER ,ZAUFGCC1,ZAUFGCC2,&                     !* COMPARED TO GETSE
    & ZAUFGDEP,ZAUANDEP,&
    & IAUSTAT ,IAUEVEN1,IAUEVEN2,IAURDBFL,IAUANFLG)

!*          6.13        END LOOP
ENDDO UPDATE_BODIES

!*
!-----------------------------------------------------------------------

!        7.             FINISH OFF REPORT CREATION
!                       --------------------------
LDTAKEN = .TRUE.

!*
!-----------------------------------------------------------------------

!        8.             RESORT BODIES
!                       -------------

IF (.NOT.LLRESORT) THEN
  DEALLOCATE(IBODY)
  IF (LHOOK) CALL DR_HOOK('OSCATIN',1,ZHOOK_HANDLE)
  RETURN
ENDIF

!*          8.1         ALLOCATE ARRAYS

ALLOCATE( ZROBODY(INBODY,NCOLS_ROBODY ))
ALLOCATE(ZSATBODY(INBODY,NCOLS_SATBODY))
ALLOCATE( IORDER(INBODY))

!*          8.2         DETERMINE REORDERING
!*                      U,V,U,V,OTHER ACCEPTED VARS,REST
IORDER(:)=0

!* FIRST FIND INDICES FOR U AND V
INDXU=0
INDXV=0
INDXD=0
INDXF=0
DO IV=1,IVAR
  IF (JVAR(IV) == 62) INDXU=IV
  IF (JVAR(IV) == 61) INDXV=IV
  IF (JVAR(IV) == 48) INDXD=IV
  IF (JVAR(IV) == 49) INDXF=IV
ENDDO

IF (INDXU == 0)                     LLRESORT=.FALSE.
IF (INDXV == 0)                     LLRESORT=.FALSE.
IF (INDXD == 0)                     LLRESORT=.FALSE.
IF (INDXF == 0)                     LLRESORT=.FALSE.
IF (JVARMAX(INDXU)/=JVARMAX(INDXV)) LLRESORT=.FALSE.
IF (JVARMAX(INDXD)/=JVARMAX(INDXF)) LLRESORT=.FALSE.

IF (.NOT.LLRESORT) THEN
  WRITE(NULOUT,'(''  OSCATIN WARNING: CANNOT REORDER'')')
  WRITE(NULOUT,*)INDXU,INDXV,JVARMAX
  DEALLOCATE(ZROBODY,ZSATBODY,IORDER,IBODY)
  IF (LHOOK) CALL DR_HOOK('OSCATIN',1,ZHOOK_HANDLE)
  RETURN
ENDIF

IALL=0
DO IH=1,JVARMAX(INDXU)
  IALL=IALL+1
  IORDER(IALL)=IBODY(INDXU,IWSORT(IH))   !* U
  IALL=IALL+1
  IORDER(IALL)=IBODY(INDXV,IWSORT(IH))   !* V
ENDDO
DO IH=1,JVARMAX(INDXD)
  IALL=IALL+1
  IORDER(IALL)=IBODY(INDXD,IWSORT(IH))   !* DD
  IALL=IALL+1
  IORDER(IALL)=IBODY(INDXF,IWSORT(IH))   !* FF
ENDDO
DO IV=1,IVAR                              !* ANY OTHER ALLOWED VARS
  IF(IV == INDXU) CYCLE
  IF(IV == INDXV) CYCLE
  IF(IV == INDXD) CYCLE
  IF(IV == INDXF) CYCLE
  DO IH=1, JVARMAX(IV)
    IALL=IALL+1
    IORDER(IALL)=IBODY(IV,IH)
  ENDDO
ENDDO
DO IH=1,INBODY                            !* REST
  IF(IBODY(0,IH) /= 0) THEN
    IALL=IALL+1
    IORDER(IALL)=IBODY(0,IH)
  ENDIF
ENDDO

IF( MINVAL(IORDER) <  MLNKH2B(KSCATP) .OR. &
 &  MAXVAL(IORDER) >= MLNKH2B(KSCATP+1) ) THEN
  DEALLOCATE(ZROBODY,ZSATBODY,IORDER,IBODY)
  WRITE(NULOUT,'(''   IORDER: '',2(I1,1X))')IORDER
  CALL ABOR1(' OSCATIN : ')
ENDIF

!*          8.2         LOOP OVER BODY ELEMENTS
REORDER_BODIES: DO IALL = 1, INBODY
  JALL=IORDER(IALL)
  ZROBODY(IALL,1:NCOLS_ROBODY ) =  ROBODY(JALL,1:NCOLS_ROBODY )
  ZSATBODY(IALL,1:NCOLS_SATBODY) = SATBODY(JALL,1:NCOLS_SATBODY)
ENDDO REORDER_BODIES

COPY_BODIES: DO IALL = 1, INBODY
    JALL=MLNKH2B(KSCATP)+IALL-1
    ROBODY(JALL,1:NCOLS_ROBODY ) =  ZROBODY(IALL,1:NCOLS_ROBODY )
    ROBODY(JALL,MDBESQN) = IALL
   SATBODY(JALL,1:NCOLS_SATBODY) = ZSATBODY(IALL,1:NCOLS_SATBODY)
ENDDO COPY_BODIES

!*          8.3         CLEAN UP
DEALLOCATE(ZROBODY,ZSATBODY,IORDER,IBODY)
!*
!-----------------------------------------------------------------------

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