SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/FA/mt/faregu

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FAREGU_MT (FA,  KNUMER, CDCLEF, KVAL, KOPT )
00003       USE FA_MOD, ONLY : FA_COM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C      Ce sous-programme controle (lecture/ecriture) les options
00008 C      de compression de GRIBEX, pour chacune des unites logiques et
00009 C      certains descripteurs GRIB communs a l'unite logique.
00010 C      (REGLAGE des options de codage de gribex pour une Unite)
00011 C**
00012 C    Arguments : KNUMER (Entree) ==> Numero de l'unite logique;
00013 C                CDCLEF (Entree) ==> Mot clef precisant l'action a faire;
00014 C                KVAL   (Sortie  ==> Valeur lue ou a ecrire;
00015 C                      ou Entree)
00016 C                KOPT   (Entree) ==> Flag: 0->lecture 1->ecriture;
00017 C*
00018 C     Signification des divers elements du tableau FA%NCOGRIF
00019 C
00020 C     FA%NCOGRIF(1,IRANG) = type de codage (0->option HOPER='C'
00021 C                                        1->option HOPER='K')
00022 C     FA%NCOGRIF(2,IRANG) = KSEC4(6), indicateur de la presence de flags
00023 C                        additionnels (0->non; 16->oui)
00024 C     FA%NCOGRIF(3,IRANG) = KSEC4(7)
00025 C     FA%NCOGRIF(4,IRANG) = KSEC4(9), indicateur de la presence de bitmaps
00026 C                        secondaires (0->non; 32->oui)
00027 C     FA%NCOGRIF(5,IRANG) = KSEC4(10), indicateur pour le nb de bits des
00028 C                        groupes de pts de grille (0->const.; 16->different)
00029 C     FA%NCOGRIF(6,IRANG) = KSEC4(11), nb de bits pour les groupes de pts de grille
00030 C                        quand il est constant.
00031 C                        Si negatif, le logiciel calcule un nb optimal a partir
00032 C                        de -KSEC4(11).
00033 C     FA%NCOGRIF(7,IRANG) = KSEC4(12), indicateur pour les extensions generales de
00034 C                        la compression (0->non; 8->oui)
00035 C     FA%NCOGRIF(8,IRANG) = KSEC4(13), indicateur pour le rearrangement boustrophedo
00036 C                        nique (0->non; 4->oui)
00037 C     FA%NCOGRIF(9,IRANG) = KSEC4(14) (valeurs possibles: -1, 0 et 2)
00038 C     FA%NCOGRIF(10,IRANG) = KSEC4(15) (valeurs possibles: -1, 0 et 1), sert avec
00039 C                         KSEC4(14) a definir la technique de la difference
00040 C                         spatiale. Si l'un des 2 est negatif, l'ordre de
00041 C                         differentiation est estime dynamiquement, sinon
00042 C                         l'ordre = KSEC4(14)+KSEC4(15)
00043 C
00044 #include "precision.h"
00045 C
00046 C
00047       TYPE(FA_COM) :: FA
00048       INTEGER KNUMER, KVAL, KOPT
00049 C
00050       CHARACTER*5 CDCLEF
00051 C
00052       INTEGER IRANG, INIMES, IREP, INBITSMAX
00053 C
00054       LOGICAL LLVERG
00055 C
00056 #include "facom2.h"
00057 #include "facom_mt.h"
00058 C
00059 C**
00060 C     0.  -  INITIALISATIONS ET ALLOCATIONS PREALABLES
00061 C-----------------------------------------------------------------------
00062 C
00063       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00064       IF (LHOOK) CALL DR_HOOK('FAREGU_MT',0,ZHOOK_HANDLE)
00065       IREP=0
00066 C
00067       CALL FANUMU_MT (FA, KNUMER,IRANG)
00068 C
00069       IF (IRANG.EQ.0) THEN
00070         IREP=-51
00071         GOTO 1001
00072       ENDIF
00073 C
00074 C Appel prealable a FAISC1 pour initialiser FA%NSEC1(2:21,IRANG).
00075 C On le fait ici plutot que dans FAINIG pour ne pas ecraser
00076 C les eventuelles modifs apportees par IDCEN et/ou IDMOD
00077 C
00078       IF (FA%LISEC1(IRANG)) THEN
00079         CALL FAISC1_MT(FA, IREP,IRANG)
00080         IF (IREP.NE.0) THEN
00081           WRITE (UNIT=FA%NULOUT,FMT=*)
00082      S           'FAREGU: ERROR ',IREP,' dans appel a FAISC1 !!'
00083           GOTO 1001
00084         ENDIF
00085         FA%LISEC1(IRANG)=.FALSE.
00086       ENDIF
00087 C
00088       INBITSMAX=MAX(FA%NBFPDG(IRANG),FA%NBFCSP(IRANG))
00089 C**
00090 C     1.  -  SPECIFICATION D'UN NOUVEAU CODAGE
00091 C-----------------------------------------------------------------------
00092 C
00093       IF (KOPT==1) THEN
00094 C
00095 C   Pas de compression (sous-tronc et puissance laplacien ajoutees
00096 C   systematiquement + tard pour les coeff spectraux)
00097 C
00098         IF (CDCLEF=='BASIC'.OR.CDCLEF=='basic') THEN
00099           FA%NCOGRIF(1,IRANG)=0
00100           FA%NCOGRIF(2,IRANG)=0
00101           FA%NCOGRIF(3,IRANG)=0
00102           FA%NCOGRIF(4,IRANG)=0
00103           FA%NCOGRIF(5,IRANG)=0
00104           FA%NCOGRIF(6,IRANG)=0
00105 C
00106 C   Comme le "BASIC" avec une compression
00107 C   ligne a ligne pour les points de grille
00108 C
00109         ELSEIF (CDCLEF=='PACK1'.OR.CDCLEF=='pack1') THEN
00110           FA%NCOGRIF(1,IRANG)=0
00111           FA%NCOGRIF(2,IRANG)=16
00112           FA%NCOGRIF(3,IRANG)=0
00113           FA%NCOGRIF(4,IRANG)=0
00114           FA%NCOGRIF(5,IRANG)=16
00115           FA%NCOGRIF(6,IRANG)=0
00116 C
00117 C   Comme le "BASIC" avec une compression
00118 C   pour les points de grille ou le nb de bits est le meme
00119 C   dans chaque groupe de points de grille
00120 C
00121         ELSEIF (CDCLEF=='PACK2'.OR.CDCLEF=='pack2') THEN
00122           FA%NCOGRIF(1,IRANG)=0
00123           FA%NCOGRIF(2,IRANG)=16
00124           FA%NCOGRIF(3,IRANG)=0
00125           FA%NCOGRIF(4,IRANG)=32
00126           FA%NCOGRIF(5,IRANG)=0
00127 C Un nb de bits optimal sera recherche par le logiciel
00128           FA%NCOGRIF(6,IRANG)=-99
00129 C
00130 C   Comme le "BASIC" avec une compression general OMM
00131 C   pour les points de grille
00132 C
00133         ELSEIF (CDCLEF=='PACK3'.OR.CDCLEF=='pack3') THEN
00134           FA%NCOGRIF(1,IRANG)=0
00135           FA%NCOGRIF(2,IRANG)=16
00136           FA%NCOGRIF(3,IRANG)=0
00137           FA%NCOGRIF(4,IRANG)=32
00138           FA%NCOGRIF(5,IRANG)=16
00139           FA%NCOGRIF(6,IRANG)=0
00140 C
00141 C   Compression "aggressive": le logiciel va
00142 C   tenter la compression ligne a ligne puis l'absence
00143 C   de compression et retenir la meilleure methode
00144 C
00145         ELSEIF (CDCLEF=='APAC1'.OR.CDCLEF=='apac1') THEN
00146           FA%NCOGRIF(1,IRANG)=1
00147           FA%NCOGRIF(2,IRANG)=16
00148           FA%NCOGRIF(3,IRANG)=0
00149           FA%NCOGRIF(4,IRANG)=0
00150           FA%NCOGRIF(5,IRANG)=16
00151           FA%NCOGRIF(6,IRANG)=0
00152 C
00153 C   Compression "aggressive": le logiciel va
00154 C   tenter la compression type "APAC1" puis celle avec le nb de bits
00155 C   constant par groupe de pts de grille et retenir la meilleure
00156 C
00157         ELSEIF (CDCLEF=='APAC2'.OR.CDCLEF=='apac2') THEN
00158           FA%NCOGRIF(1,IRANG)=1
00159           FA%NCOGRIF(2,IRANG)=16
00160           FA%NCOGRIF(3,IRANG)=0
00161           FA%NCOGRIF(4,IRANG)=0
00162           FA%NCOGRIF(5,IRANG)=0
00163 C Un nb de bits optimal sera recherche par le logiciel
00164           FA%NCOGRIF(6,IRANG)=-99
00165 C
00166 C   Compression "aggressive": le logiciel va tenter
00167 C   la compression type "APAC1" puis la compression generale
00168 C   OMM et retenir la meilleure
00169 C
00170         ELSEIF (CDCLEF=='APAC3'.OR.CDCLEF=='apac3') THEN
00171           FA%NCOGRIF(1,IRANG)=1
00172           FA%NCOGRIF(2,IRANG)=16
00173           FA%NCOGRIF(3,IRANG)=0
00174           FA%NCOGRIF(4,IRANG)=32
00175           FA%NCOGRIF(5,IRANG)=16
00176           FA%NCOGRIF(6,IRANG)=0
00177 C
00178 C   Compression "aggressive": le logiciel va
00179 C   tenter la compression type "APAC3" puis celle avec le nb de bits
00180 C   constant par groupe de pts de grille et retenir la meilleure
00181 C
00182         ELSEIF (CDCLEF=='APAC4'.OR.CDCLEF=='apac4') THEN
00183           FA%NCOGRIF(1,IRANG)=1
00184           FA%NCOGRIF(2,IRANG)=16
00185           FA%NCOGRIF(3,IRANG)=0
00186           FA%NCOGRIF(4,IRANG)=32
00187           FA%NCOGRIF(5,IRANG)=0
00188 C Un nb de bits optimal sera recherche par le logiciel
00189           FA%NCOGRIF(6,IRANG)=-99
00190 C
00191 C   Specification du nb de bits a utiliser dans le cadre
00192 C   de la compression avec nb de bits constant
00193 C   par groupe de pts de grille
00194 C   
00195         ELSEIF (CDCLEF=='WIDPA'.OR.CDCLEF=='widpa') THEN
00196           IF (KVAL.LT.1-INBITSMAX.OR.KVAL.GT.INBITSMAX-1) THEN
00197             IREP=-97
00198             WRITE (UNIT=FA%NULOUT,FMT='(A)')'Dans FAREGU, action WIDPA:'
00199             WRITE (UNIT=FA%NULOUT,FMT='(A57,I8)')
00200      S   '!!  ERREUR  !! Valeur incorrecte, non prise en compte: ',KVAL
00201             GOTO 1001
00202           ENDIF
00203           FA%NCOGRIF(6,IRANG)=KVAL
00204 C
00205 C   Demande supplementaire de la compression avec extension
00206 C   generale a la norme OMM (si KVAL=1, sinon c'est le retrait de l'option)
00207 C
00208         ELSEIF (CDCLEF=='GEXTE'.OR.CDCLEF=='gexte') THEN
00209           IF (KVAL.EQ.1) THEN
00210             CALL GRSX2O(1)
00211             FA%NCOGRIF(7,IRANG)=8
00212           ELSE
00213             FA%NCOGRIF(7,IRANG)=0
00214           ENDIF
00215 C
00216 C   Demande supplementaire du rearrangement boustrophedonique dans la compression
00217 C   (si KVAL=1, sinon c'est le retrait de cette option)
00218 C
00219         ELSEIF (CDCLEF=='BOUST'.OR.CDCLEF=='boust') THEN
00220           IF (KVAL.EQ.1) THEN
00221             CALL GRSX2O(1)
00222             FA%NCOGRIF(8,IRANG)=4
00223           ELSE
00224             FA%NCOGRIF(8,IRANG)=0
00225           ENDIF
00226 C
00227 C   Demande supplementaire de la difference spatiale dans la
00228 C   compression. KVAL donne l'ordre de differentiation
00229 C   (-1-> calcul dynamique par GRIBEX; 1 a 3->ordre; 0->desactiv; autre->err)
00230 C
00231         ELSEIF (CDCLEF=='DIFFE'.OR.CDCLEF=='diffe') THEN
00232           IF (KVAL.EQ.-1) THEN
00233             CALL GRSX2O(1)
00234             CALL GRSN2O(1)
00235             FA%NCOGRIF( 9,IRANG)=0
00236             FA%NCOGRIF(10,IRANG)=-1
00237           ELSEIF (KVAL.EQ.1) THEN
00238             CALL GRSX2O(1)
00239             CALL GRSN2O(1)
00240             FA%NCOGRIF( 9,IRANG)=0
00241             FA%NCOGRIF(10,IRANG)=1
00242           ELSEIF (KVAL.EQ.2) THEN
00243             CALL GRSX2O(1)
00244             CALL GRSN2O(1)
00245             FA%NCOGRIF( 9,IRANG)=2
00246             FA%NCOGRIF(10,IRANG)=0
00247           ELSEIF (KVAL.EQ.3) THEN
00248             CALL GRSX2O(1)
00249             CALL GRSN2O(1)
00250             FA%NCOGRIF( 9,IRANG)=2
00251             FA%NCOGRIF(10,IRANG)=1
00252           ELSEIF (KVAL.EQ.0) THEN
00253             CALL GRSN2O(0)
00254             FA%NCOGRIF( 9,IRANG)=0
00255             FA%NCOGRIF(10,IRANG)=0
00256           ELSE
00257             IREP=-125
00258             WRITE (UNIT=FA%NULOUT,FMT='(A)') 
00259      S             'Dans FAREGU, action DIFFE:'
00260             WRITE (UNIT=FA%NULOUT,FMT='(A57,I8)')
00261      S   '!!  ERREUR  !! Valeur incorrecte, non prise en compte: ',KVAL
00262             GOTO 1001
00263           ENDIF
00264 C
00265 C   Specification de l'identificateur du centre meteo (defaut=85 pour
00266 C   Toulouse; pour Reading, il vaut 98). Sera utilise pour initialiser
00267 C   KSEC1(2), le 2ieme elt de la section 1 de GRIBEX
00268 C
00269         ELSEIF (CDCLEF=='IDCEN'.OR.CDCLEF=='idcen') THEN
00270           IF (KVAL.LT.7.OR.KVAL.GT.99) THEN
00271             IREP=-125
00272             WRITE (UNIT=FA%NULOUT,FMT='(A)')  
00273      S             'Dans FAREGU, action IDCEN:'
00274             WRITE (UNIT=FA%NULOUT,FMT='(A57,I8)')
00275      S   '!!  ERREUR  !! Valeur incorrecte, non prise en compte: ',KVAL
00276             GOTO 1001
00277           ENDIF
00278           FA%NSEC1(2,IRANG)=KVAL
00279 C
00280 C   Specification de l'identificateur de modele.
00281 C   FAISC1 initialise automatiquement a
00282 C      177 pour ALADIN
00283 C      211 pour les previsions ARPEGE
00284 C      201 pour les analyses ARPEGE
00285 C   Sera utilise pour initialiser KSEC1(3).
00286 C
00287         ELSEIF (CDCLEF=='IDMOD'.OR.CDCLEF=='idmod') THEN
00288           IF (KVAL.LT.0.OR.KVAL.GT.255) THEN
00289             IREP=-125
00290             WRITE (UNIT=FA%NULOUT,FMT='(A)')  
00291      S             'Dans FAREGU, action IDMOD:'
00292             WRITE (UNIT=FA%NULOUT,FMT='(A57,I8)')
00293      S   '!!  ERREUR  !! Valeur incorrecte, non prise en compte: ',KVAL
00294             GOTO 1001
00295           ENDIF
00296           FA%NSEC1(3,IRANG)=KVAL
00297         ELSE
00298           IREP=-125
00299           WRITE (UNIT=FA%NULOUT,FMT='(A)') 
00300      S     '!!  ERREUR  !! Dans FAREGU, action inconnue: '//CDCLEF
00301           GOTO 1001
00302         ENDIF
00303 C**
00304 C     2.  -  DEMANDE D'INFORMATION
00305 C-----------------------------------------------------------------------
00306 C
00307       ELSEIF (KOPT==0) THEN
00308 C
00309 C   Obtention des mots-clef disponibles
00310 C
00311         IF (CDCLEF=='CLEFS'.OR. CDCLEF=='clefs' .OR.
00312      S      CDCLEF=='HELP' .OR. CDCLEF=='help') THEN
00313           KVAL=0
00314           WRITE (UNIT=FA%NULOUT,FMT=*)
00315           WRITE (UNIT=FA%NULOUT,FMT=*)
00316      S    'Mots clef disponibles pour FAREGU:'
00317           WRITE (UNIT=FA%NULOUT,FMT=*)
00318           WRITE (UNIT=FA%NULOUT,FMT=*)'BASIC: pas de compression'
00319           WRITE (UNIT=FA%NULOUT,FMT=*)
00320      S    'PACK1: BASIC avec une compression'
00321           WRITE (UNIT=FA%NULOUT,FMT=*)
00322      S    '       ligne a ligne pour les pts de grille'
00323           WRITE (UNIT=FA%NULOUT,FMT=*)
00324      S    'PACK2: BASIC avec une compression avec'
00325           WRITE (UNIT=FA%NULOUT,FMT=*)
00326      S    '       nb de bits cst pour les groupes'
00327           WRITE (UNIT=FA%NULOUT,FMT=*)
00328      S    'PACK3: BASIC avec une compression generale'
00329           WRITE (UNIT=FA%NULOUT,FMT=*)
00330      S    '       OMM pour les points de grille'
00331           WRITE (UNIT=FA%NULOUT,FMT=*)
00332      S    'APAC1: compression agressive:'
00333           WRITE (UNIT=FA%NULOUT,FMT=*)
00334      S    '       BASIC et PACK1 sont testes'
00335           WRITE (UNIT=FA%NULOUT,FMT=*)
00336      S    'APAC2: compression agressive:'
00337           WRITE (UNIT=FA%NULOUT,FMT=*)
00338      S    '       BASIC, PACK1 et PACK2 sont testes'
00339           WRITE (UNIT=FA%NULOUT,FMT=*)
00340      S    'APAC3: compression agressive:'
00341           WRITE (UNIT=FA%NULOUT,FMT=*)
00342      S    '       BASIC, PACK1 et PACK3 sont testes'
00343           WRITE (UNIT=FA%NULOUT,FMT=*)
00344      S    'APAC4: compression agressive:'
00345           WRITE (UNIT=FA%NULOUT,FMT=*)
00346      S    '       BASIC, PACK1, PACK2 et PACK3 testes'
00347           WRITE (UNIT=FA%NULOUT,FMT=*)
00348      S    'WIDPA: lecture/ecriture du nb de bits'
00349           WRITE (UNIT=FA%NULOUT,FMT=*)
00350      S    '       a utiliser pour les groupes de points'
00351           WRITE (UNIT=FA%NULOUT,FMT=*)
00352      S    '       de grille dans le cas PACK2'
00353           WRITE (UNIT=FA%NULOUT,FMT=*)
00354      S    'GEXTE: la compression avec extensions generales'
00355           WRITE (UNIT=FA%NULOUT,FMT=*)
00356      S    '       activees (KVAL=1) ou desactivees (KVAL=0)'
00357           WRITE (UNIT=FA%NULOUT,FMT=*)
00358      S    'BOUST: le rearrangement boustrophedonique est'
00359           WRITE (UNIT=FA%NULOUT,FMT=*)
00360      S    '       active (KVAL=1) ou desactive (KVAL=0)'
00361           WRITE (UNIT=FA%NULOUT,FMT=*)
00362      S    'DIFFE: la differenciation spatiale est'
00363           WRITE (UNIT=FA%NULOUT,FMT=*)
00364      S    '       activee (KVAL=ordre de differ. (1 a 3)'
00365           WRITE (UNIT=FA%NULOUT,FMT=*)
00366      S    '       ou -1 (calcul dyn)) ou desactivee (0)'
00367           WRITE (UNIT=FA%NULOUT,FMT=*)
00368      S    'IDCEN: lect/ecriture de l''identificateur du'
00369           WRITE (UNIT=FA%NULOUT,FMT=*)
00370      S    '       centre meteo'
00371           WRITE (UNIT=FA%NULOUT,FMT=*)
00372      S    'IDMOD: lect/ecriture de l''identificateur du'
00373           WRITE (UNIT=FA%NULOUT,FMT=*)
00374      S    '       modele'
00375           WRITE (UNIT=FA%NULOUT,FMT=*)
00376 C
00377 C   Lecture du nb de bits a utiliser dans le cadre
00378 C   de la compression avec nb de bits
00379 C   constant par groupe de pts de grille
00380 C   
00381         ELSEIF (CDCLEF=='WIDPA'.OR.CDCLEF=='widpa') THEN
00382           KVAL=FA%NCOGRIF(6,IRANG)
00383 C
00384 C   Lecture de la presence ou non de la compression
00385 C   "general extended"
00386 C
00387         ELSEIF (CDCLEF=='GEXTE'.OR.CDCLEF=='gexte') THEN
00388           KVAL = FA%NCOGRIF(7,IRANG)/8
00389 C
00390 C   Lecture de la presence ou non du rearrangement
00391 C   boustrophedonique.
00392 C
00393         ELSEIF (CDCLEF=='BOUST'.OR.CDCLEF=='boust') THEN
00394           KVAL = FA%NCOGRIF(8,IRANG)/4
00395 C
00396 C   Lecture de la presence ou non de la differentiation spatiale
00397 C
00398         ELSEIF (CDCLEF=='DIFFE'.OR.CDCLEF=='diffe') THEN
00399           KVAL=FA%NCOGRIF( 9,IRANG)+FA%NCOGRIF(10,IRANG)
00400 C
00401 C   Lecture de l'identificateur du centre meteo (defaut=85 pour
00402 C   Toulouse; pour Reading, il vaut 98). Sera utilise pour initialiser
00403 C   KSEC1(2), le 2ieme elt de la section 1 de GRIBEX
00404 C
00405         ELSEIF (CDCLEF=='IDCEN'.OR.CDCLEF=='idcen') THEN
00406           KVAL=FA%NSEC1(2,IRANG)
00407 C
00408 C   Lecture de l'identificateur du modele
00409 C
00410         ELSEIF (CDCLEF=='IDMOD'.OR.CDCLEF=='idmod') THEN
00411           KVAL=FA%NSEC1(3,IRANG)
00412         ELSE
00413           IREP=-125
00414           WRITE (UNIT=FA%NULOUT,FMT='(A)') 
00415      S      '!!  ERREUR  !! Dans FAREGU, action inconnue: '//CDCLEF
00416           GOTO 1001
00417         ENDIF
00418 C**
00419 C     3.  -  OPTION INCONNUE
00420 C-----------------------------------------------------------------------
00421 C
00422       ELSE
00423         IREP=-125
00424         WRITE (UNIT=FA%NULOUT,FMT='(A57,I8)')
00425      S    '!!  ERREUR  !! Dans FAREGU, option inconnue: KOPT= ',KOPT
00426         GOTO 1001
00427       ENDIF
00428 C**
00429 C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
00430 C            VIA LE SOUS-PROGRAMME "FAIPAR" .
00431 C-----------------------------------------------------------------------
00432 C
00433  1001 CONTINUE
00434       LLFATA=LLMOER (IREP,IRANG)
00435 C
00436       IF (LLFATA) THEN
00437         INIMES=2
00438       ELSE
00439         INIMES=IXNVMS(IRANG)
00440       ENDIF
00441 C
00442       IF (INIMES.EQ.0)  THEN 
00443         IF (LHOOK) CALL DR_HOOK('FAREGU_MT',1,ZHOOK_HANDLE)
00444         RETURN
00445       ENDIF
00446 C
00447       CLNSPR='FAREGU'
00448 C
00449       WRITE (UNIT=CLMESS,FMT='(''IREP='',I4,'', KNUMER='
00450 ',I3,     S         '', CDCLEF='''''',A,'''''', KVAL='
00451 ',I12,     S        '', KOPT='',I4)')
00452      S              IREP,KNUMER,CDCLEF,KVAL,KOPT
00453       CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,LLFATA,CLMESS,
00454      S                CLNSPR,CLNSPR,.FALSE.)
00455 C
00456       IF (LHOOK) CALL DR_HOOK('FAREGU_MT',1,ZHOOK_HANDLE)
00457       END
00458