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

Go to the documentation of this file.
00001       SUBROUTINE PACKGB ( PFDATA, KPACKD, PREFER, PSCALE, KLENG )
00002       USE PARKIND1, ONLY : JPRB
00003       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00004 C
00005 C********************************************************************
00006 C*
00007 C*    NAME      : PACKGB
00008 C*
00009 C*    FUNCTION  : COMPUTES INDIVIDUAL "PACKED" VALUES (FIELD FOR GRIB),
00010 C*                THE RESULT CONSISTS OF ONE DATA READY TO PACK
00011 C*                WITHIN A BIT STRING PER COMPUTER WORD.
00012 C*                   This subroutine has been designed to avoid explicit
00013 C*                mixed use of REAL and INTEGER type values within the
00014 C*                dummy-argument array PFDATA of CODEGA, this explicit
00015 C*                use leading to non-standard code. The following code
00016 C*                enables use of the same actual argument for the 2
00017 C*                dummy-argument arrays.
00018 C*
00019 C*    INPUT     : PFDATA - FLOATING-POINT VALUES TO BE PACKED.
00020 C*                PREFER - REFERENCE VALUE OF THE FIELD: SHOULD BE THE
00021 C*                         MINIMUM VALUE, OR AN "UNDER-APPROXIMATION"
00022 C*                         OF THE MINIMUM VALUE).
00023 C*                PSCALE - SCALING FACTOR.
00024 C*                KLENG  - NUMBER OF VALUES TO TREAT.
00025 C*
00026 C*    OUTPUT    : KPACKD - (POSITIVE) INTEGER VALUES "READY TO PACK"
00027 C*
00028 C*    AUTHOR    : J.CLOCHARD, FRENCH WEATHER SERVICE, 01/03/90.
00029 C*
00030 C********************************************************************
00031 C*
00032 #include "precision.h"
00033 C
00034 C     JP_STRIDE= pas permettant la correspondance entre les elements
00035 C                d'un tableau de reels (KIND=JPDBLR): PFDATA(J) et
00036 C                les elements d'un tableau d'entiers KPACKD(JP_STRIDE*J)
00037 C                defini comme un tableau d'entiers representes sur
00038 C                autant de bits que les reels.
00039 C
00040       INTEGER, PARAMETER :: JP_STRIDE = JPDBLR / JP_SIMPLE_ENTIER
00041 !
00042 ! If integers are on 32 bits, don't be afraid by the number of bits of the 
00043 ! real argument which is real and on 64 bits ... it's a trick : we pack 
00044 ! PFDATA to KPACKD in the same area, but with half bit and we are kind 
00045 ! enough to have a stride of 2 to access KPACKD ... ! (see also unpagb.F)
00046 !
00047       INTEGER KLENG
00048 C
00049       INTEGER KPACKD (JP_STRIDE*KLENG)
00050 C
00051       REAL (KIND=JPDBLR) PREFER, PSCALE
00052 C
00053       REAL (KIND=JPDBLR) PFDATA (KLENG)
00054 C
00055       INTEGER J, II
00056       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00057 C**
00058 C     1.  -  STRAIGHT-FORWARD COMPUTING.
00059 C
00060       IF (LHOOK) CALL DR_HOOK('PACKGB',0,ZHOOK_HANDLE)
00061 !$OMP PARALLEL DO PRIVATE(J,II) SCHEDULE(STATIC,4096)
00062       DO 101 J=1,KLENG
00063 #if defined(LITTLE_ENDIAN) || defined(LITTLE)
00064         II=JP_STRIDE*J -1
00065 #else
00066         II=JP_STRIDE*J
00067 #endif
00068         KPACKD(II)=NINT ( ( PFDATA(J) - PREFER ) * PSCALE )
00069   101 CONTINUE
00070 !$OMP END PARALLEL DO
00071 C
00072       IF (LHOOK) CALL DR_HOOK('PACKGB',1,ZHOOK_HANDLE)
00073       END