faregu.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE faregu_fort                                 &
&                     (fa,  knumer, cdclef, kval, kopt)
USE fa_mod, ONLY : fa_com
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!      Ce sous-programme controle (lecture/ecriture) les options
!      de compression de GRIBEX, pour chacune des unites logiques et
!      certains descripteurs GRIB communs a l'unite logique.
!      (REGLAGE des options de codage de gribex pour une Unite)
!**
!    Arguments : KNUMER (Entree) ==> Numero de l'unite logique;
!                CDCLEF (Entree) ==> Mot clef precisant l'action a faire;
!                KVAL   (Sortie  ==> Valeur lue ou a ecrire;
!                      ou Entree)
!                KOPT   (Entree) ==> Flag: 0->lecture 1->ecriture;
!*
!     Signification des divers elements du tableau NCOGRIF
!
!     NCOGRIF(1) = type de codage (0->option HOPER='C'
!                               1->option HOPER='K')
!     NCOGRIF(2) = KSEC4(6), indicateur de la presence de flags
!               additionnels (0->non; 16->oui)
!     NCOGRIF(3) = KSEC4(7)
!     NCOGRIF(4) = KSEC4(9), indicateur de la presence de bitmaps
!               secondaires (0->non; 32->oui)
!     NCOGRIF(5) = KSEC4(10), indicateur pour le nb de bits des
!               groupes de pts de grille (0->const.; 16->different)
!     NCOGRIF(6) = KSEC4(11), nb de bits pour les groupes de pts de grille
!               quand il est constant.
!               Si negatif, le logiciel calcule un nb optimal a partir
!               de -KSEC4(11).
!     NCOGRIF(7) = KSEC4(12), indicateur pour les extensions generales de
!               la compression (0->non; 8->oui)
!     NCOGRIF(8) = KSEC4(13), indicateur pour le rearrangement boustrophedo
!               nique (0->non; 4->oui)
!     NCOGRIF(9) = KSEC4(14) (valeurs possibles: -1, 0 et 2)
!     NCOGRIF(10) = KSEC4(15) (valeurs possibles: -1, 0 et 1), sert avec
!                KSEC4(14) a definir la technique de la difference
!                spatiale. Si l'un des 2 est negatif, l'ordre de
!                differentiation est estime dynamiquement, sinon
!                l'ordre = KSEC4(14)+KSEC4(15)
!     NCOGRIF(11) = 1->Calcul automatique de KSEC1 (23), 0->On laisse faire
!     NCODGRI(12) = Ecriture des champs GRIB1 dans un fichier externe
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KNUMER, KVAL, KOPT
!
CHARACTER(LEN=*) CDCLEF
!
INTEGER (KIND=JPLIKB) IRANG, INIMES, IREP, INBITSMAX
!
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR
LOGICAL                  LLFATA

!
!**
!     0.  -  INITIALISATIONS ET ALLOCATIONS PREALABLES
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAREGU_MT',0,zhook_handle)
irep=0
!
CALL fanumu_fort                 &
&               (fa, knumer,irang)
!
IF (irang.EQ.0) THEN
  irep=-51
  GOTO 1001
ENDIF
!
! Appel prealable a FAISC1 pour initialiser FA%NSEC1(2:21,IRANG).
! On le fait ici plutot que dans FAINIG pour ne pas ecraser
! les eventuelles modifs apportees par IDCEN et/ou IDMOD
!
IF (fa%FICHIER(irang)%LISEC1) THEN
  CALL faisc1_fort              &
&                (fa, irep,irang)
  IF (irep.NE.0) THEN
    WRITE (unit=fa%NULOUT,fmt=*) &
&           'FAREGU: ERROR ',irep,' dans appel a FAISC1 !!'
    GOTO 1001
  ENDIF
  fa%FICHIER(irang)%LISEC1=.false.
ENDIF
!
inbitsmax=max(fa%FICHIER(irang)%NBFPDG,fa%FICHIER(irang)%NBFCSP)
!**
!     1.  -  SPECIFICATION D'UN NOUVEAU CODAGE
!-----------------------------------------------------------------------
!
IF (kopt==1) THEN
!
!   Pas de compression (sous-tronc et puissance laplacien ajoutees
!   systematiquement + tard pour les coeff spectraux)
!
  IF (cdclef=='BASIC'.OR.cdclef=='basic') THEN
    fa%FICHIER(irang)%NCOGRIF(1)=0
    fa%FICHIER(irang)%NCOGRIF(2)=0
    fa%FICHIER(irang)%NCOGRIF(3)=0
    fa%FICHIER(irang)%NCOGRIF(4)=0
    fa%FICHIER(irang)%NCOGRIF(5)=0
    fa%FICHIER(irang)%NCOGRIF(6)=0
!
!   Comme le "BASIC" avec une compression
!   ligne a ligne pour les points de grille
!
  ELSEIF (cdclef=='PACK1'.OR.cdclef=='pack1') THEN
    fa%FICHIER(irang)%NCOGRIF(1)=0
    fa%FICHIER(irang)%NCOGRIF(2)=16
    fa%FICHIER(irang)%NCOGRIF(3)=0
    fa%FICHIER(irang)%NCOGRIF(4)=0
    fa%FICHIER(irang)%NCOGRIF(5)=16
    fa%FICHIER(irang)%NCOGRIF(6)=0
!
!   Comme le "BASIC" avec une compression
!   pour les points de grille ou le nb de bits est le meme
!   dans chaque groupe de points de grille
!
  ELSEIF (cdclef=='PACK2'.OR.cdclef=='pack2') THEN
    fa%FICHIER(irang)%NCOGRIF(1)=0
    fa%FICHIER(irang)%NCOGRIF(2)=16
    fa%FICHIER(irang)%NCOGRIF(3)=0
    fa%FICHIER(irang)%NCOGRIF(4)=32
    fa%FICHIER(irang)%NCOGRIF(5)=0
! Un nb de bits optimal sera recherche par le logiciel
    fa%FICHIER(irang)%NCOGRIF(6)=-99
!
!   Comme le "BASIC" avec une compression general OMM
!   pour les points de grille
!
  ELSEIF (cdclef=='PACK3'.OR.cdclef=='pack3') THEN
    fa%FICHIER(irang)%NCOGRIF(1)=0
    fa%FICHIER(irang)%NCOGRIF(2)=16
    fa%FICHIER(irang)%NCOGRIF(3)=0
    fa%FICHIER(irang)%NCOGRIF(4)=32
    fa%FICHIER(irang)%NCOGRIF(5)=16
    fa%FICHIER(irang)%NCOGRIF(6)=0
!
!   Compression "aggressive": le logiciel va
!   tenter la compression ligne a ligne puis l'absence
!   de compression et retenir la meilleure methode
!
  ELSEIF (cdclef=='APAC1'.OR.cdclef=='apac1') THEN
    fa%FICHIER(irang)%NCOGRIF(1)=1
    fa%FICHIER(irang)%NCOGRIF(2)=16
    fa%FICHIER(irang)%NCOGRIF(3)=0
    fa%FICHIER(irang)%NCOGRIF(4)=0
    fa%FICHIER(irang)%NCOGRIF(5)=16
    fa%FICHIER(irang)%NCOGRIF(6)=0
!
!   Compression "aggressive": le logiciel va
!   tenter la compression type "APAC1" puis celle avec le nb de bits
!   constant par groupe de pts de grille et retenir la meilleure
!
  ELSEIF (cdclef=='APAC2'.OR.cdclef=='apac2') THEN
    fa%FICHIER(irang)%NCOGRIF(1)=1
    fa%FICHIER(irang)%NCOGRIF(2)=16
    fa%FICHIER(irang)%NCOGRIF(3)=0
    fa%FICHIER(irang)%NCOGRIF(4)=0
    fa%FICHIER(irang)%NCOGRIF(5)=0
! Un nb de bits optimal sera recherche par le logiciel
    fa%FICHIER(irang)%NCOGRIF(6)=-99
!
!   Compression "aggressive": le logiciel va tenter
!   la compression type "APAC1" puis la compression generale
!   OMM et retenir la meilleure
!
  ELSEIF (cdclef=='APAC3'.OR.cdclef=='apac3') THEN
    fa%FICHIER(irang)%NCOGRIF(1)=1
    fa%FICHIER(irang)%NCOGRIF(2)=16
    fa%FICHIER(irang)%NCOGRIF(3)=0
    fa%FICHIER(irang)%NCOGRIF(4)=32
    fa%FICHIER(irang)%NCOGRIF(5)=16
    fa%FICHIER(irang)%NCOGRIF(6)=0
!
!   Compression "aggressive": le logiciel va
!   tenter la compression type "APAC3" puis celle avec le nb de bits
!   constant par groupe de pts de grille et retenir la meilleure
!
  ELSEIF (cdclef=='APAC4'.OR.cdclef=='apac4') THEN
    fa%FICHIER(irang)%NCOGRIF(1)=1
    fa%FICHIER(irang)%NCOGRIF(2)=16
    fa%FICHIER(irang)%NCOGRIF(3)=0
    fa%FICHIER(irang)%NCOGRIF(4)=32
    fa%FICHIER(irang)%NCOGRIF(5)=0
! Un nb de bits optimal sera recherche par le logiciel
    fa%FICHIER(irang)%NCOGRIF(6)=-99
!
!   Specification du nb de bits a utiliser dans le cadre
!   de la compression avec nb de bits constant
!   par groupe de pts de grille
!   
  ELSEIF (cdclef=='WIDPA'.OR.cdclef=='widpa') THEN
    IF (kval.LT.1-inbitsmax.OR.kval.GT.inbitsmax-1) THEN
      irep=-97
      WRITE (unit=fa%NULOUT,fmt='(A)')'Dans FAREGU, action WIDPA:'
      WRITE (unit=fa%NULOUT,fmt='(A57,I8)')                       &
&   '!!  ERREUR  !! Valeur incorrecte, non prise en compte: ',kval
      GOTO 1001
    ENDIF
    fa%FICHIER(irang)%NCOGRIF(6)=kval
!
!   Demande supplementaire de la compression avec extension
!   generale a la norme OMM (si KVAL=1, sinon c'est le retrait de l'option)
!
  ELSEIF (cdclef=='GEXTE'.OR.cdclef=='gexte') THEN
    IF (kval.EQ.1) THEN
      fa%FICHIER(irang)%IOPTGRSX2O=1
      fa%FICHIER(irang)%NCOGRIF(7)=8
    ELSE
      fa%FICHIER(irang)%NCOGRIF(7)=0
    ENDIF
!
!   Demande supplementaire du rearrangement boustrophedonique dans la compression
!   (si KVAL=1, sinon c'est le retrait de cette option)
!
  ELSEIF (cdclef=='BOUST'.OR.cdclef=='boust') THEN
    IF (kval.EQ.1) THEN
      fa%FICHIER(irang)%IOPTGRSX2O=1
      fa%FICHIER(irang)%NCOGRIF(8)=4
    ELSE
      fa%FICHIER(irang)%NCOGRIF(8)=0
    ENDIF
!
!   Demande supplementaire de la difference spatiale dans la
!   compression. KVAL donne l'ordre de differentiation
!   (-1-> calcul dynamique par GRIBEX; 1 a 3->ordre; 0->desactiv; autre->err)
!
  ELSEIF (cdclef=='DIFFE'.OR.cdclef=='diffe') THEN
    IF (kval.EQ.-1) THEN
      fa%FICHIER(irang)%IOPTGRSX2O=1
      fa%FICHIER(irang)%IOPTGRSN2O=1
      fa%FICHIER(irang)%NCOGRIF( 9)=0
      fa%FICHIER(irang)%NCOGRIF(10)=-1
    ELSEIF (kval.EQ.1) THEN
      fa%FICHIER(irang)%IOPTGRSX2O=1
      fa%FICHIER(irang)%IOPTGRSN2O=1
      fa%FICHIER(irang)%NCOGRIF( 9)=0
      fa%FICHIER(irang)%NCOGRIF(10)=1
    ELSEIF (kval.EQ.2) THEN
      fa%FICHIER(irang)%IOPTGRSX2O=1
      fa%FICHIER(irang)%IOPTGRSN2O=1
      fa%FICHIER(irang)%NCOGRIF( 9)=2
      fa%FICHIER(irang)%NCOGRIF(10)=0
    ELSEIF (kval.EQ.3) THEN
      fa%FICHIER(irang)%IOPTGRSX2O=1
      fa%FICHIER(irang)%IOPTGRSN2O=1
      fa%FICHIER(irang)%NCOGRIF( 9)=2
      fa%FICHIER(irang)%NCOGRIF(10)=1
    ELSEIF (kval.EQ.0) THEN
      fa%FICHIER(irang)%IOPTGRSX2O=0
      fa%FICHIER(irang)%NCOGRIF( 9)=0
      fa%FICHIER(irang)%NCOGRIF(10)=0
    ELSE
      irep=-125
      WRITE (unit=fa%NULOUT,fmt='(A)')    &
&             'Dans FAREGU, action DIFFE:'
      WRITE (unit=fa%NULOUT,fmt='(A57,I8)')                       &
&   '!!  ERREUR  !! Valeur incorrecte, non prise en compte: ',kval
      GOTO 1001
    ENDIF
!
!   Specification de l'identificateur du centre meteo (defaut=85 pour
!   Toulouse; pour Reading, il vaut 98). Sera utilise pour initialiser
!   KSEC1(2), le 2ieme elt de la section 1 de GRIBEX
!
  ELSEIF (cdclef=='IDCEN'.OR.cdclef=='idcen') THEN
    IF (kval.LT.7.OR.kval.GT.99) THEN
      irep=-125
      WRITE (unit=fa%NULOUT,fmt='(A)')    &
&             'Dans FAREGU, action IDCEN:'
      WRITE (unit=fa%NULOUT,fmt='(A57,I8)') &
&   '!!  ERREUR  !! Valeur incorrecte, non prise en compte: ',kval
      GOTO 1001
    ENDIF
    fa%FICHIER(irang)%NSEC1(2) = kval
    fa%FICHIER(irang)%NIDCEN   = kval

!
!   Specification de l'identificateur de modele.
!   FAISC1 initialise automatiquement a
!      177 pour ALADIN
!      211 pour les previsions ARPEGE
!      201 pour les analyses ARPEGE
!   Sera utilise pour initialiser KSEC1(3).
!
  ELSEIF (cdclef=='IDMOD'.OR.cdclef=='idmod') THEN
    IF (kval.LT.0.OR.kval.GT.255) THEN
      irep=-125
      WRITE (unit=fa%NULOUT,fmt='(A)')    &
&             'Dans FAREGU, action IDMOD:'
      WRITE (unit=fa%NULOUT,fmt='(A57,I8)') &
&   '!!  ERREUR  !! Valeur incorrecte, non prise en compte: ',kval
      GOTO 1001
    ENDIF
    fa%FICHIER(irang)%NSEC1(3)=kval
  ELSEIF (cdclef(1:min(7, len(cdclef)))=='CMODEL=') THEN
    fa%FICHIER(irang)%CMODEL = cdclef(8:)
!
!   Facteur decimal; calcul automatique
!
  ELSEIF (cdclef=='FACDEC'.OR.cdclef=='facdec') THEN
    fa%FICHIER(irang)%NCOGRIF(11)=kval
!
!   Ecriture dans un fichier externe
!
  ELSEIF (cdclef=='EXTERN'.OR.cdclef=='extern') THEN
    fa%FICHIER(irang)%NCOGRIF(12)=kval
  ELSE
    irep=-125
    WRITE (unit=fa%NULOUT,fmt='(A)') &
&     '!!  ERREUR  !! Dans FAREGU, action inconnue: '//cdclef
    GOTO 1001
  ENDIF
!**
!     2.  -  DEMANDE D'INFORMATION
!-----------------------------------------------------------------------
!
ELSEIF (kopt==0) THEN
!
!   Obtention des mots-clef disponibles
!
  IF (cdclef=='CLEFS'.OR. cdclef=='clefs' .OR. &
&      cdclef=='HELP' .OR. cdclef=='help') THEN
    kval=0
    WRITE (unit=fa%NULOUT,fmt=*)
    WRITE (unit=fa%NULOUT,fmt=*) 'Mots clef disponibles pour FAREGU:'
    WRITE (unit=fa%NULOUT,fmt=*)
    WRITE (unit=fa%NULOUT,fmt=*) 'BASIC: pas de compression'
    WRITE (unit=fa%NULOUT,fmt=*) 'PACK1: BASIC avec une compression'
    WRITE (unit=fa%NULOUT,fmt=*) '       ligne a ligne pour les pts de grille'
    WRITE (unit=fa%NULOUT,fmt=*) 'PACK2: BASIC avec une compression avec'
    WRITE (unit=fa%NULOUT,fmt=*) '       nb de bits cst pour les groupes'
    WRITE (unit=fa%NULOUT,fmt=*) 'PACK3: BASIC avec une compression generale'
    WRITE (unit=fa%NULOUT,fmt=*) '       OMM pour les points de grille'
    WRITE (unit=fa%NULOUT,fmt=*) 'APAC1: compression agressive:'
    WRITE (unit=fa%NULOUT,fmt=*) '       BASIC et PACK1 sont testes'
    WRITE (unit=fa%NULOUT,fmt=*) 'APAC2: compression agressive:'
    WRITE (unit=fa%NULOUT,fmt=*) '       BASIC, PACK1 et PACK2 sont testes'
    WRITE (unit=fa%NULOUT,fmt=*) 'APAC3: compression agressive:'
    WRITE (unit=fa%NULOUT,fmt=*) '       BASIC, PACK1 et PACK3 sont testes'
    WRITE (unit=fa%NULOUT,fmt=*) 'APAC4: compression agressive:'
    WRITE (unit=fa%NULOUT,fmt=*) '       BASIC, PACK1, PACK2 et PACK3 testes'
    WRITE (unit=fa%NULOUT,fmt=*) 'WIDPA: lecture/ecriture du nb de bits'
    WRITE (unit=fa%NULOUT,fmt=*) '       a utiliser pour les groupes de points'
    WRITE (unit=fa%NULOUT,fmt=*) '       de grille dans le cas PACK2'
    WRITE (unit=fa%NULOUT,fmt=*) 'GEXTE: la compression avec extensions generales'
    WRITE (unit=fa%NULOUT,fmt=*) '       activees (KVAL=1) ou desactivees (KVAL=0)'
    WRITE (unit=fa%NULOUT,fmt=*) 'BOUST: le rearrangement boustrophedonique est'
    WRITE (unit=fa%NULOUT,fmt=*) '       active (KVAL=1) ou desactive (KVAL=0)'
    WRITE (unit=fa%NULOUT,fmt=*) 'DIFFE: la differenciation spatiale est'
    WRITE (unit=fa%NULOUT,fmt=*) '       activee (KVAL=ordre de differ. (1 a 3)'
    WRITE (unit=fa%NULOUT,fmt=*) '       ou -1 (calcul dyn)) ou desactivee (0)'
    WRITE (unit=fa%NULOUT,fmt=*) 'IDCEN: lect/ecriture de l''identificateur du'
    WRITE (unit=fa%NULOUT,fmt=*) '       centre meteo'
    WRITE (unit=fa%NULOUT,fmt=*) 'IDMOD: lect/ecriture de l''identificateur du'
    WRITE (unit=fa%NULOUT,fmt=*) '       modele'
    WRITE (unit=fa%NULOUT,fmt=*) 'CMODEL: lect/ecriture de l''identificateur du'
    WRITE (unit=fa%NULOUT,fmt=*) '        modele'
    WRITE (unit=fa%NULOUT,fmt=*) 'FACDEC: calcul automatique du facteur decimal'
    WRITE (unit=fa%NULOUT,fmt=*) 'EXTERN: ecriture dans un fichier externe'
    WRITE (unit=fa%NULOUT,fmt=*)
!
!   Lecture du nb de bits a utiliser dans le cadre
!   de la compression avec nb de bits
!   constant par groupe de pts de grille
!   
  ELSEIF (cdclef=='WIDPA'.OR.cdclef=='widpa') THEN
    kval=fa%FICHIER(irang)%NCOGRIF(6)
!
!   Lecture de la presence ou non de la compression
!   "general extended"
!
  ELSEIF (cdclef=='GEXTE'.OR.cdclef=='gexte') THEN
    kval = fa%FICHIER(irang)%NCOGRIF(7)/8
!
!   Lecture de la presence ou non du rearrangement
!   boustrophedonique.
!
  ELSEIF (cdclef=='BOUST'.OR.cdclef=='boust') THEN
    kval = fa%FICHIER(irang)%NCOGRIF(8)/4
!
!   Lecture de la presence ou non de la differentiation spatiale
!
  ELSEIF (cdclef=='DIFFE'.OR.cdclef=='diffe') THEN
    kval=fa%FICHIER(irang)%NCOGRIF( 9)+fa%FICHIER(irang)%NCOGRIF(10)
!
!   Lecture de l'identificateur du centre meteo (defaut=85 pour
!   Toulouse; pour Reading, il vaut 98). Sera utilise pour initialiser
!   KSEC1(2), le 2ieme elt de la section 1 de GRIBEX
!
  ELSEIF (cdclef=='IDCEN'.OR.cdclef=='idcen') THEN
    kval=fa%FICHIER(irang)%NIDCEN
!
!   Lecture de l'identificateur du modele
!
  ELSEIF (cdclef=='IDMOD'.OR.cdclef=='idmod') THEN
    kval=fa%FICHIER(irang)%NSEC1(3)
  ELSEIF (cdclef(1:min(7, len(cdclef)))=='CMODEL=') THEN
    cdclef(8:) = fa%FICHIER(irang)%CMODEL
!
!   Facteur decimal; calcul automatique
!
  ELSEIF (cdclef=='FACDEC'.OR.cdclef=='facdec') THEN
    kval=fa%FICHIER(irang)%NCOGRIF(11)
!
!   Ecriture dans un fichier externe
!
  ELSEIF (cdclef=='EXTERN'.OR.cdclef=='extern') THEN
    kval=fa%FICHIER(irang)%NCOGRIF(12)
  ELSE
    irep=-125
    WRITE (unit=fa%NULOUT,fmt='(A)')                          &
&      '!!  ERREUR  !! Dans FAREGU, action inconnue: '//cdclef
    GOTO 1001
  ENDIF
!**
!     3.  -  OPTION INCONNUE
!-----------------------------------------------------------------------
!
ELSE
  irep=-125
  WRITE (unit=fa%NULOUT,fmt='(A57,I8)')                        &
&    '!!  ERREUR  !! Dans FAREGU, option inconnue: KOPT= ',kopt
  GOTO 1001
ENDIF
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
!            VIA LE SOUS-PROGRAMME "FAIPAR" .
!-----------------------------------------------------------------------
!
1001 CONTINUE
llfata=llmoer(irep,irang)
!
IF (llfata) THEN
  inimes=2
ELSE
  inimes=ixnvms(irang)
ENDIF
!
IF (.NOT.llfata.AND.inimes.NE.2)  THEN
  IF (lhook) CALL dr_hook('FAREGU_MT',1,zhook_handle)
  RETURN
ENDIF
!
clnspr='FAREGU'
!
WRITE (unit=clmess,fmt='(''IREP='',I4,'', KNUMER='',I3,  &
&         '', CDCLEF='''''',A,'''''', KVAL='',I12,       &
&        '', KOPT='',I4)')                               &
&              irep,knumer,cdclef,kval,kopt
CALL faipar_fort                                       &
&               (fa, knumer,inimes,irep,llfata,clmess, &
&                clnspr,clnspr,.false.)
!
IF (lhook) CALL dr_hook('FAREGU_MT',1,zhook_handle)

CONTAINS

#include "facom2.llmoer.h"
#include "facom2.ixnvms.h"

END SUBROUTINE faregu_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE faregu64                    &
&           (knumer, cdclef, kval, kopt)
USE fa_mod, ONLY : fa => fa_com_default, &
&                  fa_com_default_init,  &
&                  new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KNUMER                                 ! IN   
CHARACTER (LEN=*)      CDCLEF                                 ! IN   
INTEGER (KIND=JPLIKB)  KVAL                                   ! INOUT
INTEGER (KIND=JPLIKB)  KOPT                                   ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faregu_fort                           &
&           (fa, knumer, cdclef, kval, kopt)

END SUBROUTINE faregu64

SUBROUTINE faregu                      &
&           (knumer, cdclef, kval, kopt)
USE fa_mod, ONLY : fa => fa_com_default, &
&                  fa_com_default_init,  &
&                  new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
CHARACTER (LEN=*)      CDCLEF                                 ! IN   
INTEGER (KIND=JPLIKM)  KVAL                                   ! INOUT
INTEGER (KIND=JPLIKM)  KOPT                                   ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faregu_mt                             &
&           (fa, knumer, cdclef, kval, kopt)

END SUBROUTINE faregu

SUBROUTINE faregu_mt                       &
&           (fa, knumer, cdclef, kval, kopt)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
CHARACTER (LEN=*)      CDCLEF                                 ! IN   
INTEGER (KIND=JPLIKM)  KVAL                                   ! INOUT
INTEGER (KIND=JPLIKM)  KOPT                                   ! IN   
! Local integers
INTEGER (KIND=JPLIKB)  INUMER                                 ! IN   
INTEGER (KIND=JPLIKB)  IVAL                                   ! INOUT
INTEGER (KIND=JPLIKB)  IOPT                                   ! IN   
! Convert arguments

inumer     = int(    knumer, jplikb)
IF (kopt==1) THEN
  ival       = int(      kval, jplikb)
ENDIF
iopt       = int(      kopt, jplikb)

CALL faregu_fort                           &
&           (fa, inumer, cdclef, ival, iopt)

IF (kopt==0) THEN
  kval       = int(      ival, jplikm)
ENDIF

END SUBROUTINE faregu_mt

!INTF KNUMER        IN                                                                 
!INTF CDCLEF        IN                                                                 
!INTF KVAL          INOUT IN_IF=KOPT==1                  OUT_IF=KOPT==0                
!INTF KOPT          IN