SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/grib_mf/gbyte

Go to the documentation of this file.
00001       SUBROUTINE GBYTE_MF(KSOURC,KDEST,KOFSET,KBYTSZ)
00002       USE PARKIND1, ONLY : JPRB
00003       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00004 C*****
00005 C*
00006 C*    FUNCTION: GET A SINGLE BIT FIELD FROM KSOURC INTO KDEST
00007 C*
00008 C*    INPUT   : KSOURC(1)= WORD CONTAINING START OF BIT FIELD
00009 C*              KDEST    = TARGET WORD
00010 C*              KOFSET   = OFFSET IN BITS FOR START OF THE FIELD
00011 C*              KBYTSZ   = LENGTH OF FIELD IN BITS
00012 C*
00013 C*    OUTPUT  : KSOURC,KOFSET,KBYTSZ UNCHANGED
00014 C*              KDEST CONTAINS FIELD RIGHT JUSTIFIED
00015 C*
00016 C*    AUTHOR  : M.MIQUEU   08/1981 (REWRITTEN FROM J.MARTELLET'S)
00017 C*
00018 C*****
00019 C
00020 #include "precision.h"
00021 C
00022       INTEGER KOFSET, KBYTSZ
00023       INTEGER (KIND=JPDBLE) KDEST
00024 C
00025       INTEGER (KIND=JPDBLE) KSOURC (2)
00026 C
00027       INTEGER INBPW, ISH1
00028 C
00029       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00030       IF (LHOOK) CALL DR_HOOK('GBYTE_MF',0,ZHOOK_HANDLE)
00031       INBPW=64
00032       ISH1=KOFSET+KBYTSZ-INBPW
00033 C
00034       IF(ISH1.LE.0) THEN
00035 C
00036 C
00037 C     BYTES DO NOT SPAN WORDS
00038 C
00039 C
00040         ISH1=-ISH1
00041 C
00042 C
00043         KDEST=IBITS (KSOURC(1),ISH1,KBYTSZ)
00044 C
00045       ELSE
00046 C
00047 C     BYTE SPANS WORDS
00048 C
00049 C
00050         KDEST=IOR (
00051      1              ISHFT (
00052      2                      IBITS (KSOURC(1),0,INBPW-KOFSET)
00053      3                     , ISH1 )
00054      4             ,
00055      5              IBITS (KSOURC(2),INBPW-ISH1,ISH1)
00056      6            )
00057 C
00058 C
00059 C
00060       ENDIF
00061 C
00062       IF (LHOOK) CALL DR_HOOK('GBYTE_MF',1,ZHOOK_HANDLE)
00063       END