decf10.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Interface to thread-safe FA
FUNCTION decf10               &
&                           (kgrib,  kleng, kdecal,  &
&                           kfaori, kfamod, knbimo)
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!     Fonction "DECF10"
!
!     But.
!     ---
!
!     Effectuer dans un message GRIB au niveau d'edition 1 le decalage
!     (en valeur) du descripteur "facteur d'echelle decimal".
!
!
!**   Interface.
!     ----------
!
!
!      Arguments d'appel:
!
!     KGRIB  (Entree+ ===> Tableau receptacle pour le message GRIB
!             Sortie)
!     KLENG  (Entree) ===> Longueur utile (mots) de KGRIB
!     KDECAL (Entree) ===> DECALage (additif) a effectuer sur la valeur
!                          courante du facteur d'echelle decimal.
!     KFAORI (Sortie) ===> FActeur decimal d'ORIgine
!     KFAMOD (Sortie) ===> FActeur decimal MODifie
!     KNBIMO (Entree) ===> Nombre de BIts par mot (entier)
!
!     Le code-retour de la fonction est:
!
!      0 si tout s'est bien passe
!     -1 si KGRIB ne commence pas par un entete GRIB
!     -2 si l'edition du GRIB ne convient pas
!     >0 code-retour (erreur) INXBIT
!
!
!     Methode.
!     --------
!
!     Verifie le niveau d'edition du message GRIB, decode le facteur
!     d'echelle decimal courant, y ajoute KDECAL, et remplace la valeur
!     par insertion dans le message.
!
!
!     Sous-programmes/fonctions externes utilises.
!     --------------------------------------------
!
!     INXBIT - INsertion d'une chaine binaire
!
!     Reference.
!     ----------
!
!     Aucune.
!
!
!     Commentaires.
!     -------------
!
!     Cettte fonction a ete developpee dans le cadre du pretraitement de
!     modeles etrangers arrivant sous forme de fichiers, pour DIAPASON
!     et SYNERGIE. Mais elle n'en depend pas vraiment, et peut donc
!     etre reutilisee dans un autre contexte.
!
!     Dans sa mouture initiale, seule l'edition 1 de GRIB est geree.
!
!     On utilise une primitive de bas niveau de la bibliotheque
!     "emos" du CEPMMT.
!
!     La convention de codage du signe du facteur d'echelle est
!     explicitement geree par la fonction courante.
!
!
!     Auteur.
!     -------
!
!     J. Clochard, Meteo France, DSI/OP/D - Juin 2001.
!
!
!     Modifications.
!     --------------
!
!     Aucune.
!
!
!
!     Constantes symboliques.
!
!     Signification des PARAMETER "locaux" au sous-programme :
!
!     JPDGRB => Nombre d'octets a decoder pour controler le message GRIB
!     JPGRIB => Nombre d'octets a decoder pour controler l'entete GRIB
!
INTEGER (KIND=JPLIKB) DECF10
!
INTEGER JPDGRB, JPGRIB
!
parameter( jpdgrb = 8, jpgrib = 4 )
!
!     Arguments d'appel.
!
INTEGER (KIND=JPLIKB) KLENG, KDECAL, KFAORI, KFAMOD, KNBIMO
!
INTEGER KGRIB (kleng)
!
!     Variables locales.
!
INTEGER IAUXIL, IREPON, J, IDECAL, ILODES, IPIVOT, IFACOD, IFAC10
!
INTEGER IDGRIB (jpdgrb)
INTEGER ILENG, INBIMO
!
!     Caracteres G, R, I, B en code CCITT IA-5
!
INTEGER, PARAMETER :: IBLOCD (jpgrib) = (/ 71, 82, 73, 66 /)
!
CHARACTER(LEN=1) CLOPER
!**
!     1.  -  INITIALISATIONS ET CONTROLES.
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DECF10',0,zhook_handle)
irepon = 0
kfaori = -9999
kfamod = kfaori
ileng  = int(kleng,  jplikm)
inbimo = int(knbimo, jplikm)
!
IF ( kdecal .EQ. 0 ) THEN
!
  GO TO 900
!
ENDIF
!
!     Deocdage des premiers octets du message GRIB.
!
cloper = 'D'
idecal = 0
iauxil = jpdgrb
ilodes = 8
!
CALL inxbit( kgrib,  ileng, idecal, idgrib, iauxil, inbimo, &
&             ilodes, cloper, irepon )
!
IF ( irepon .NE. 0 ) THEN
!
  GO TO 900
!
ENDIF
!
!     KGRIB commence-t-il bien par les 4 lettres GRIB ?
!
DO j = 1, jpgrib
!
  IF( idgrib(j) .NE. iblocd(j) ) THEN
!
    irepon = -1
!
    GO TO 900
!
  ENDIF
!
ENDDO
!
!     Controle du niveau d'edition de GRIB.
!
IF( idgrib(jpdgrb) .NE. 1 ) THEN
!
  irepon = -2
!
  GO TO 900
!
ENDIF
!
idecal = (8+26)*8
iauxil = 1
ilodes = 16
ipivot = 2**15
!**
!     2.  -  DECODAGE DU FACTEUR D'ECHELLE DECIMAL COURANT.
!-----------------------------------------------------------------------
!
!
CALL inxbit( kgrib,  ileng, idecal, ifacod, iauxil, inbimo, &
&             ilodes, cloper, irepon )
idecal = idecal-ilodes*iauxil
!
IF ( irepon .NE. 0 ) THEN
!
  GO TO 900
!
ELSEIF ( ifacod .LE. ipivot ) THEN
!
  ifac10 = ifacod
!
ELSE
!
  ifac10 = ipivot-ifacod
!
ENDIF
!
kfaori = int(ifac10, jplikb)
!**
!     3.  -  MODIFICATION DU FACTEUR D'ECHELLE DECIMAL COURANT.
!-----------------------------------------------------------------------
!
!
ifac10 = ifac10+ int(kdecal, jplikm)
kfamod = int(ifac10, jplikb)
cloper = 'C'
!
IF ( ifac10 .GE. 0 ) THEN
!
  ifacod = ifac10
!
ELSE
!
  ifacod = ipivot-ifac10
!
ENDIF
!
CALL inxbit( kgrib,  ileng, idecal, ifacod, iauxil, inbimo, &
&             ilodes, cloper, irepon )
!**
!     9.  -  MESSAGERIE EVENTUELLE, RETOUR A L'APPLICATIF APPELANT.
!-----------------------------------------------------------------------
!
900 CONTINUE
!
decf10 = int(irepon, jplikb)
!
IF (lhook) CALL dr_hook('DECF10',1,zhook_handle)
END FUNCTION decf10