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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FAVEUR_MT (FA,  KREP, KNUMER, KNGRIB, KNBPDG, KNBCSP, 
00003      S                    KSTRON, KPUILA, KDMOPL )
00004       USE FA_MOD, ONLY : FA_COM
00005       USE PARKIND1, ONLY : JPRB
00006       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00007 C****
00008 C        Ce sous-programme permet d'obtenir, pour un fichier ARPEGE
00009 C     ouvert, les options courantes liees au codage GRIB des champs.
00010 C     CES OPTIONS NE SONT UTILISEES QUE POUR (RE)ECRIRE DES CHAMPS
00011 C     codes en GRIB.
00012 C       ( Visualisation (?) options Effectives pour l'UtilisateuR )
00013 C**
00014 C     Arguments : KREP   ==> Code-reponse du sous-programme;
00015 C     (tous de    KNUMER ==> Numero d'Unite Logique concernee;
00016 C      SORTIE)    KNGRIB ==> Niveau de codage GRIB (-1,0,1,2,3);
00017 C                 KNBPDG ==> Nombre de bits par valeur point-de-grille;
00018 C                 KNBCSP ==> Nombre de bits par partie reelle/imaginaire
00019 C                            de coefficient spectral;
00020 C                 KSTRON ==> Sous-troncature non compactee;
00021 C                 KPUILA ==> Puissance de laplacien;
00022 C                 KDMOPL ==> Degre de modulation de KPUILA.
00023 C
00024 #include "precision.h"
00025 C
00026 C
00027       TYPE(FA_COM) :: FA
00028       INTEGER KREP, KNUMER, KNGRIB, KNBPDG, KNBCSP, KSTRON, KPUILA
00029       INTEGER KDMOPL
00030 C
00031       INTEGER IREP, IRANG, INIMES
00032 C
00033       LOGICAL LLVERF
00034 C
00035 #include "facom2.h"
00036 #include "facom_mt.h"
00037 C**
00038 C     1.  -  INITIALISATIONS.
00039 C-----------------------------------------------------------------------
00040 C
00041       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00042       IF (LHOOK) CALL DR_HOOK('FAVEUR_MT',0,ZHOOK_HANDLE)
00043       LLVERF=.FALSE.
00044       CALL FANUMU_MT (FA, KNUMER,IRANG)
00045 C
00046       IF (IRANG.EQ.0) THEN
00047         IREP=-51
00048         GOTO 1001
00049       ENDIF
00050 C
00051 C         Verrouillage eventuel du fichier.
00052 C
00053       IF (FA%LFAMUL) CALL LFIVER_MT (FA%LFI, FA%VRFICH(IRANG),'ON')
00054       LLVERF=FA%LFAMUL
00055 C**
00056 C     2.  -  RECOPIE DES VALEURS EN COMMON DANS LES ARGUMENTS.
00057 C-----------------------------------------------------------------------
00058 C
00059       KNGRIB=FA%NFGRIB(IRANG)
00060       KNBPDG=FA%NBFPDG(IRANG)
00061       KNBCSP=FA%NBFCSP(IRANG)
00062       KSTRON=FA%NSTROF(IRANG)
00063       KPUILA=FA%NPUFLA(IRANG)
00064       KDMOPL=FA%NMFDPL(IRANG)
00065       IREP=0
00066 C**
00067 C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
00068 C            VIA LE SOUS-PROGRAMME "FAIPAR" .
00069 C-----------------------------------------------------------------------
00070 C
00071  1001 CONTINUE
00072       KREP=IREP
00073       LLFATA=LLMOER (IREP,IRANG)
00074 C
00075 C        Deverrouillage eventuel du fichier.
00076 C
00077       IF (LLVERF) CALL LFIVER_MT (FA%LFI, FA%VRFICH(IRANG),'OFF')
00078 C
00079       IF (LLFATA) THEN
00080         INIMES=2
00081       ELSE
00082         INIMES=IXNVMS(IRANG)
00083       ENDIF
00084 C
00085       IF (.NOT.LLFATA.AND.INIMES.NE.2)  THEN 
00086         IF (LHOOK) CALL DR_HOOK('FAVEUR_MT',1,ZHOOK_HANDLE)
00087         RETURN
00088       ENDIF
00089 C
00090       CLNSPR='FAVEUR'
00091 C
00092       WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
00093 ',I3,     S       '', KNGRIB='',I2,'', KNBPDG='',I3,'', KNBCSP='
00094 ',I3,     S       '', KSTRON='',I2,'', KPUILA='',I3,'', KDMOPL='',I3)')
00095      S   KREP,KNUMER,KNGRIB,KNBPDG,KNBCSP,KSTRON,KPUILA,KDMOPL
00096       CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,LLFATA,CLMESS,
00097      S                CLNSPR,CLACTI,.FALSE.)
00098 C
00099       IF (LHOOK) CALL DR_HOOK('FAVEUR_MT',1,ZHOOK_HANDLE)
00100       END
00101