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

Go to the documentation of this file.
00001       SUBROUTINE GSBYTE_MF ( KS, KD, KOFF, KSIZE, KSKBTW, K, KBPW,
00002      S                    CDADIR, KLENG, KERR, KWORD, LDNEXT )
00003       USE PARKIND1, ONLY : JPRB
00004       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00005 C
00006       INTEGER JPSHOR
00007 C
00008       PARAMETER ( JPSHOR=100 )
00009 C
00010 #include "precision.h"
00011 C
00012       INTEGER KOFF, KSIZE, KSKBTW, K, KBPW, KLENG, KERR, KWORD
00013 C
00014       INTEGER (KIND=JPDBLE) KS (*), KD (*)
00015 C
00016       LOGICAL LDNEXT
00017 C
00018       CHARACTER*1 CDADIR
00019 C
00020       INTEGER IWORD, IOFF, IOFF2
00021       INTEGER (KIND=JPDBLE) IMASKS (128)
00022 C
00023       SAVE IMASKS
00024 C
00025       DATA IMASKS(2) / 0 /
00026 C
00027       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00028       IF (LHOOK) CALL DR_HOOK('GSBYTE_MF',0,ZHOOK_HANDLE)
00029       KERR=0
00030 C
00031       IF (K.GT.0) THEN
00032         IOFF2=KOFF+(KSIZE+KSKBTW)*K
00033 C
00034         IF (LDNEXT) THEN
00035 C
00036           IWORD=KWORD+IOFF2/KBPW
00037           IOFF=MOD (IOFF2,KBPW)
00038         ELSE
00039           IWORD=KWORD+(IOFF2-1)/KBPW
00040           IOFF=1+MOD (IOFF2-1,KBPW)
00041         ENDIF
00042         IF (IWORD.GT.KLENG) THEN
00043           KERR = -2
00044           IF (CDADIR.EQ.'D') THEN
00045             WRITE (UNIT=*,FMT=*)
00046      S'GSBYTE - UNABLE TO PROCEED REQUESTED EXTRACTION FROM BIT STREAM:'
00047           ELSE
00048             WRITE (UNIT=*,FMT=*)
00049      S'GSBYTE - UNABLE TO PROCEED REQUESTED INSERTION INTO BIT STREAM:'
00050           ENDIF
00051           IF (LDNEXT) THEN
00052             WRITE (UNIT=*,FMT='('' GSBYTE - NEXT WORD'
00053 ',I9,     S             '' WOULD BE OUTSIDE ARRAY BOUNDS'',I9)') IWORD,KLENG
00054           ELSE
00055             WRITE (UNIT=*,FMT='('' GSBYTE - LAST WORD'
00056 ',I9,     S             '' WOULD BE OUTSIDE ARRAY BOUNDS'',I9)') IWORD,KLENG
00057           ENDIF
00058           IF (LHOOK) CALL DR_HOOK('GSBYTE_MF',1,ZHOOK_HANDLE)
00059           RETURN
00060         ENDIF
00061       ELSE
00062         IWORD=KWORD
00063         IOFF=KOFF
00064       ENDIF
00065 C     Vector machines use preferably GSBITE_MF :
00066 #if  defined ( NECSX ) || defined ( VPP ) || defined ( CRAY )
00067       IF (K.GT.JPSHOR.OR.K.LE.0) THEN
00068         CALL GSBITE_MF (KS,KD,KOFF,KSIZE,KSKBTW,K,KBPW,IMASKS,CDADIR)
00069       ELSEIF (CDADIR.EQ.'D') THEN
00070         CALL GBYTES_MF (KS,KD,KOFF,KSIZE,KSKBTW,K)
00071       ELSE
00072         CALL SBYTES_MF (KS,KD,KOFF,KSIZE,KSKBTW,K)
00073       ENDIF
00074 #else
00075       IF (CDADIR.EQ.'D') THEN
00076         CALL GBYTES_MF (KS,KD,KOFF,KSIZE,KSKBTW,K)
00077       ELSE
00078         CALL SBYTES_MF (KS,KD,KOFF,KSIZE,KSKBTW,K)
00079       ENDIF
00080 #endif
00081 
00082       KWORD=IWORD
00083       KOFF=IOFF
00084       IF (LHOOK) CALL DR_HOOK('GSBYTE_MF',1,ZHOOK_HANDLE)
00085       END