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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FAVORI_MT (FA,  KNGRIB, KNBPDG, KNBCSP, KSTRON, KPUILA,
00003      S                    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 de connaitre les options implicites
00009 C     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, et les valeurs implicites ne servent
00012 C     que LORS d'une OUVERTURE de FICHIER.
00013 C       ( Visualisation (?) Options R (??) Implicites )
00014 C**
00015 C     Arguments : KNGRIB ==> Niveau de codage GRIB (-1,0,1,2,3);
00016 C     (tous de    KNBPDG ==> Nombre de bits par valeur point-de-grille;
00017 C      SORTIE)    KNBCSP ==> Nombre de bits par partie reelle/imaginaire
00018 C                            de coeff. spectral;
00019 C                 KSTRON ==> Sous-troncature non compactee;
00020 C                 KPUILA ==> Puissance de laplacien;
00021 C                 KDMOPL ==> Degre de modulation de KPUILA.
00022 C
00023 #include "precision.h"
00024 C
00025 C
00026       TYPE(FA_COM) :: FA
00027       INTEGER KNGRIB, KNBPDG, KNBCSP, KSTRON, KPUILA, KDMOPL
00028 C
00029       INTEGER IREP, INIMES, INUMER
00030 C
00031       LOGICAL LLVERG
00032 C
00033 C
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('FAVORI_MT',0,ZHOOK_HANDLE)
00043       IF (FA%FAVORI_LLPREA) THEN
00044 C
00045 C          A la premiere utilisation, appel au sous-programme "FARINE".
00046 C
00047         CALL FARINE_MT(FA, 2)
00048         FA%FAVORI_LLPREA=.FALSE.
00049       ENDIF
00050 C
00051 C         Verrouillage global eventuel.
00052 C
00053       IF (FA%LFAMUL) CALL LFIVER_MT (FA%LFI, FA%VRGLAS,'ON')
00054       LLVERG=FA%LFAMUL
00055 C**
00056 C     2.  -  RECOPIE DES VALEURS EN COMMON DANS LES ARGUMENTS.
00057 C-----------------------------------------------------------------------
00058 C
00059       KNGRIB=FA%NIGRIB
00060       KNBPDG=FA%NBIPDG
00061       KNBCSP=FA%NBICSP
00062       KSTRON=FA%NSTROI
00063       KPUILA=FA%NPUILA
00064       KDMOPL=FA%NMIDPL
00065 C**
00066 C    10.  -  PHASE TERMINALE : MESSAGERIE VIA LE SOUS-PROGRAMME "FAIPAR"
00067 C-----------------------------------------------------------------------
00068 C
00069  1001 CONTINUE
00070 C
00071 C        Deverrouillage global eventuel.
00072 C
00073       IF (LLVERG) CALL LFIVER_MT (FA%LFI, FA%VRGLAS,'OFF')
00074 C
00075       IF (FA%NIMSGA.EQ.2) THEN
00076         IREP=0
00077         INIMES=2
00078         CLNSPR='FAVORI'
00079         WRITE (UNIT=CLMESS,FMT='(''KNGRIB='',I2,'', KNBPDG='
00080 ',I3,     S         '', KNBCSP='',I3,'', KSTRON='',I3,'', KPUILA='
00081 ',I3,     S         '', KDMOPL='',I3)')
00082      S    KNGRIB,KNBPDG,KNBCSP,KSTRON,KPUILA,KDMOPL
00083         INUMER=FA%JPNIIL
00084         CALL FAIPAR_MT (FA, INUMER,INIMES,IREP,.FALSE.,CLMESS,
00085      S                  CLNSPR,CLACTI,.FALSE.)
00086       ENDIF
00087 C
00088       IF (LHOOK) CALL DR_HOOK('FAVORI_MT',1,ZHOOK_HANDLE)
00089       END
00090