gsbyte_mf.F

Go to the documentation of this file.

      SUBROUTINE gsbyte_mf ( KS, KD, KOFF, KSIZE, KSKBTW, K, KBPW,      &
     &                    CDADIR, KLENG, KERR, KWORD, LDNEXT )
      USE parkind1, ONLY : jprb
      USE yomhook , ONLY : lhook, dr_hook
      USE lfi_precision
!
      IMPLICIT NONE
      INTEGER (KIND=JPLIKM), PARAMETER :: JPSHOR=100
!
!
      INTEGER (KIND=JPLIKM) :: KOFF
      INTEGER (KIND=JPLIKM) :: KSIZE
      INTEGER (KIND=JPLIKM) :: KSKBTW
      INTEGER (KIND=JPLIKM) :: K
      INTEGER (KIND=JPLIKM) :: KBPW
      INTEGER (KIND=JPLIKM) :: KLENG
      INTEGER (KIND=JPLIKM) :: KERR
      INTEGER (KIND=JPLIKM) :: KWORD
!
      INTEGER (KIND=JPLIKB) :: KS (*)
      INTEGER (KIND=JPLIKB) :: KD (*)
!
      LOGICAL :: LDNEXT
!
      CHARACTER(LEN=1) :: CDADIR
!
      INTEGER (KIND=JPLIKM) :: IWORD, IOFF, IOFF2
      INTEGER (KIND=JPLIKB) :: IMASKS (128)
!
      SAVE imasks
!
      DATA imasks(2) / 0 /
!
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      IF (lhook) CALL dr_hook('GSBYTE_MF',0,zhook_handle)
      kerr=0
!
      IF (k.GT.0) THEN
        ioff2=koff+(ksize+kskbtw)*k
!
        IF (ldnext) THEN
!
          iword=kword+ioff2/kbpw
          ioff=mod(ioff2,kbpw)
        ELSE
          iword=kword+(ioff2-1)/kbpw
          ioff=1+mod(ioff2-1,kbpw)
        ENDIF
        IF (iword.GT.kleng) THEN
          kerr = -2
          IF (cdadir.EQ.'D') THEN
            WRITE (unit=*,fmt=*)                                        &
     &'GSBYTE - UNABLE TO PROCEED REQUESTED EXTRACTION FROM BIT STREAM:'
          ELSE
            WRITE (unit=*,fmt=*)                                        &
     &'GSBYTE - UNABLE TO PROCEED REQUESTED INSERTION INTO BIT STREAM:'
          ENDIF
          IF (ldnext) THEN
            WRITE (unit=*,fmt='('' GSBYTE - NEXT WORD'',I9,             &
     &             '' WOULD BE OUTSIDE ARRAY BOUNDS'',I9)') iword,kleng
          ELSE
            WRITE (unit=*,fmt='('' GSBYTE - LAST WORD'',I9,             &
     &             '' WOULD BE OUTSIDE ARRAY BOUNDS'',I9)') iword,kleng
          ENDIF
          IF (lhook) CALL dr_hook('GSBYTE_MF',1,zhook_handle)
          RETURN
        ENDIF
      ELSE
        iword=kword
        ioff=koff
      ENDIF
!     Vector machines use preferably GSBITE_MF :
#if  defined ( NECSX ) || defined ( VPP ) || defined ( CRAY )
      IF (k.GT.jpshor.OR.k.LE.0) THEN
        CALL gsbite_mf (ks,kd,koff,ksize,kskbtw,k,kbpw,imasks,cdadir)
      ELSEIF (cdadir.EQ.'D') THEN
        CALL gbytes_mf (ks,kd,koff,ksize,kskbtw,k)
      ELSE
        CALL sbytes_mf (ks,kd,koff,ksize,kskbtw,k)
      ENDIF
#else
      IF (cdadir.EQ.'D') THEN
        CALL gbytes_mf (ks,kd,koff,ksize,kskbtw,k)
      ELSE
        CALL sbytes_mf (ks,kd,koff,ksize,kskbtw,k)
      ENDIF
#endif

      kword=iword
      koff=ioff
      IF (lhook) CALL dr_hook('GSBYTE_MF',1,zhook_handle)
      ENDSUBROUTINE gsbyte_mf