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


      SUBROUTINE DSWMRS(IBLOSW,LOGISW,ILLGTH,INSOUT,IILGTH,RESOUT,
     S                  IRLGTH,MGRIBS,ILENSW,IBITMC,LPRINTS)
C
C---->
C**** *DSWMRS* - ROUTINE TO DECODE A MARS MODEL SWITCH.
C
C     G.K.SAKELLARIDES  ECMWF        17/05/85.
C     THE STRUCTURE IS SIMILAR TO J.HENNESSY'S SUBROUTINE *DECOGR*
C
C     PURPOSE.
C     --------
C
C          TO DECODE A MODEL SWITCH MARS RECORD FROM MARS PACKED
C          SWITCH RECORD AS WELL AS TO PRINT THE DECOTED RECORD
C          IN CASE LPRINTS=.TRUE.
C
C**   INTERFACE.
C     ----------
C
C         *CALL* *DSWMRS(IBLOSW,LOGISW,ILLGTH,INSOUT,IILGTH,RESOUT,
C                       IRLGTH,MGRIBS,ILENSW,IBITMC)*
C        WHERE:
C              INPUT PARAMETERS
C              1.*MGRIBS* ARRAY CONTAINING THE PACKED MARS MODEL SWITCH
C              2.*ILENSW* THE LENGTH OF THE ARRAY MGRIBS (750 CRAY WORD)
C              3.*IBITMC* NUMBER OF BITS PER COMPUTER WORD.
C              4.*LPRINTS* .TRUE. IF AN OUTPUT OF THE DECOTED MARS
C                           MODEL SWITCH RECORD IS REQUIRED.
C              OUTPUT PARAMETERS
C              1.*IBLOSW* INTEGER ARRAY OF LENGTH 29 CONTAINING
C                          THE FOLLOWING INFORMATIONS OF BLOCK1.
C  1.1                        G
C  1.2                        R
C  1.3                        I
C  1.4                        B
C  1.5         IDENTIFICATION OF CENTRE)
C  1.6         MODEL IDENTIFICATION
C  1.7         GRID DEFINITION
C  1.8         FLAG (CODE TABLE 1)
C  1.9         PARAM. INTICATING THE MARS MODEL SWITCH REC.
C  1.10         TYPE OF LEVEL (CODE TABLE 3)
C  1.11         VALUE 1 OF LEVEL (CODE TABLE 3)
C  1.12         VALUE 2 OF LEVEL (CODE TABLE 3)
C  1.13         YEAR    OF INITIAL DATA
C  1.14         MONTH   OF INITIAL DATA
C  1.15         DAY     OF INITIAL DATA
C  1.16         HOUR    OF INITIAL DATA
C  1.17         MINUTE  OF INITIAL DATA
C  1.18         TIME UNIT (CODE TABLE 4)
C  1.19         TIME RANGE 1
C  1.20         TIME RANGE 2
C  1.21         TIME RANGE FLAG (CODE TABLE 5)
C  1.22-24      RESERVED
C  1.26         STARTING ADDRESS OF LOGICAL SECTION(OCTET)
C  1.27         STARTING ADDRESS OF INTEGER SECTION(OCTET)
C  1.28         STARTING ADDRESS OF REAL    SECTION(OCTET)
C  1.29         LENGTH           OF REAL    SECTION(OCTET)
C              2.*LOGISW* INTEGER ARRAY OF SUFFICIENT LENGTH WHICH
C                          CONTAINS THE LOGICALS.
C              3.*ILLGTH* ACTUAL LENGTH OF LOGICALS
C              4.*INSOUT* INTEGER ARRAY OF SUFFICIENT LENGTH WHICH
C                         CONTAINS THE INTEGERS
C              5.*IILGTH* ACTUAL LENGTH OF INTEGER
C              6.*RESOUT* REAL ARRAY OF SUFFICIENT LENGTH WHICH
C                         CONTAINS THE REALS
C              7.*IRLGTH* ACTUAL LENGTH OF REALS
C
C     EXTERNALS.
C     ----------
C
C         *GBYTES*   EXTRACT BIT FIELD
C         *GBYTE *   EXTRACT BIT FIELD
C         *OFFSET*  CALCULATES THE WORD AND BIT OFFSET OF THE START
C                   OF THE NEXT BIT FIELD.
C         *DECFP*   DECODE GRIB CODE REPRESENTATION TO FLOATING POINT
C                   NUMBER.
C
C----<
C
      DIMENSION IBLOSW(*),INSOUT(*),RESOUT(*),MGRIBS(ILENSW)
      DIMENSION ILSOUT(500)
      DIMENSION IAA(4)
      LOGICAL LOGISW(*),LPRINTS
C
C*              1. SET LOCAL VARIABLES
C
  100 CONTINUE
      IERR=0
      ILMGRIB=ILENSW
      IBITCR=IBITMC
C
C*              1.5 VARIABLES OF BLOCK 1
C
      IWORD=1
      IBYTE=8
      IVAL=24
      IOFF=0
      CALL GBYTES(MGRIBS(IWORD),IBLOSW(1),IOFF,IBYTE,0,IVAL)
      CALL OFFSET(IOFF,IVAL,IWORD,IBYTE,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0) GO TO 900
C
C*     LENTHG OF DATA BLOCK(OCTET)
      CALL GBYTE(MGRIBS(IWORD),IBLOSW(25),IOFF,24)
      CALL OFFSET(IOFF,1,IWORD,24,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0)GO TO 900
C
C*     STARTING ADDRESS OF LOGICAL  AND INTEGER SECTION
      IBYTE=8
      IVAL=2
      CALL GBYTES(MGRIBS(IWORD),IBLOSW(26),IOFF,IBYTE,0,IVAL)
      CALL OFFSET(IOFF,IVAL,IWORD,IBYTE,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0)GO TO 900
C*     STARTING ADDRESS OF REAL SECTION
      CALL GBYTE(MGRIBS(IWORD),IBLOSW(28),IOFF,16)
      CALL OFFSET(IOFF,1,IWORD,16,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0)GO TO 900
C* LENGTH OF REAL SECTION
      CALL GBYTE(MGRIBS(IWORD),IBLOSW(29),IOFF,16)
      CALL OFFSET(IOFF,1,IWORD,16,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0)GO TO 900
C
C*              3. BLOCK 4 DATA
C                  ----
C
  300 CONTINUE
C
C*         3.1 LOGICALS
C              DECODE LOGICALS FROM MARS FORMAT
C
  310 CONTINUE
C*           FINDS LENGTH OF LOGICALS
      ILLGTH=IBLOSW(27)-IBLOSW(26)
      IBYTE=8
      IVAL=ILLGTH
      CALL GBYTES(MGRIBS(IWORD),ILSOUT(1),IOFF,IBYTE,0,IVAL)
      CALL OFFSET(IOFF,IVAL,IWORD,IBYTE,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0) GO TO 900
      DO 314 I=1,ILLGTH
C--   LOGISW(I)=SHIFTL(ILSOUT(I),63)
      IF (ILSOUT(I).EQ.1) LOGISW(I) = .TRUE.
C--
  314 CONTINUE
C
C*         3.2 INTEGERS
C
C*      LENGTH OF INTEGERS
      IILGTH=(IBLOSW(28)-IBLOSW(27))/2
      IBYTE=16
      IVAL=IILGTH
      CALL GBYTES(MGRIBS(IWORD),INSOUT(1),IOFF,IBYTE,0,IVAL)
      CALL OFFSET(IOFF,IVAL,IWORD,IBYTE,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0)GO TO 900
C*         3.3 REALS
C
C*    LENGTH OF REAL SECTION
      IRLGTH=IBLOSW(29)/4
      DO 335 J=1,IRLGTH
      CALL GBYTE(MGRIBS(IWORD),IEXP,IOFF,8)
      CALL OFFSET(IOFF,1,IWORD,8,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0)GO TO 900
      CALL GBYTE(MGRIBS(IWORD),IMANT,IOFF,24)
      CALL OFFSET(IOFF,1,IWORD,24,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0)GO TO 900
      CALL DECFP(RESOUT(J),IEXP,IMANT)
  335 CONTINUE
C
C
C*         3.4 UNUSED WORDS
C
  340 CONTINUE
C*    USED OCTET
      IUSED=33+ILLGTH+IILGTH*2+IRLGTH*4
C*    UNUSED OCTET
      IUNUSE=ILENSW*8-4-IUSED
      DO 345 J=1,IUNUSE
      CALL GBYTE(MGRIBS(IWORD),IEEE,IOFF,8)
      CALL OFFSET(IOFF,1,IWORD,8,IBITCR,ILMGRIB,IERR)
      IF (IERR.NE.0)GO TO 900
  345 CONTINUE
C
C*                3.5 CORECT LENGTH OF INTEGER SECTION
C
  350 CONTINUE
      INGL=INSOUT(6)
      INLEV=INSOUT(6+INGL+1)
      J1A=1
      J1T=6
      J2A=J1T+1
      J2T=J2A+INGL-1
      J3A=J2T+1
      J3T=J3A+14-1
      J4A=J3T+1
      J4T=J4A+INGL-1
      J5A=J4T+1
      J5T=J5A+INGL-1
      J6A=J5T+1
      J6T=J6A+10-1
      J7A=J6T+1
      J7T=J7A+INLEV-1
      J8A=J7T+1
      J8T=J8A+INLEV-1
      J9A=J8T+1
      J9T=J9A+INLEV-1
      IILGTH=J9T
C
C*          4. BLOCK 5
C
  400 CONTINUE
      CALL GBYTES(MGRIBS(IWORD),IAA(1),IOFF,8,0,4)
C
C
C*            5. OUTPUT
C
  500 CONTINUE
      IF (LPRINTS) THEN
C
         CALL ANALSW(IBLOSW,LOGISW,ILLGTH,INSOUT,IILGTH,
     S              RESOUT,IRLGTH)
C
      ENDIF
C
C*           6. RETURN
C
  600 CONTINUE
      RETURN
C
C*             9. ERROR HANDLING
C
  900 CONTINUE
      WRITE(*,9901)
      WRITE(*,'(A)') 'ERROR IN OFFSET'
      CALL ENDRUN
      STOP
 9901 FORMAT('ERROR IN SUBROUTINE DSWMRS')
      END
