SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/LFI/mt/lfiems

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIEMS_MT (LFI, KNUMER, KNIMES, KCODE, LDFATA, 
00003      S                      CDMESS, CDNSPR, CDACTI )
00004       USE LFIMOD, ONLY : LFICOM
00005       USE PARKIND1, ONLY : JPRB
00006       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00007 C****
00008 C        CE SOUS-PROGRAMME EST CHARGE DE FAIRE L'ECHO DES MESSAGES
00009 C     EMIS PAR LE LOGICIEL DE FICHIERS INDEXES LFI, EN FAISANT SI
00010 C     BESOIN EST L'"ABORT" DU PROGRAMME .
00011 C        En l'occurrence, il s'agit d'un "chapeau" qui aiguille sur
00012 C     LFIEFR ou LFIENG en fonction de la variable logique LFI%LFRANC.
00013 C**
00014 C        ARGUMENTS : KNUMER ==> Numero eventuel de l'Unite Logique;
00015 C        ( tous                 ( si LFI%JPNIL ==> pas d'Unite Logique )
00016 C         d'Entree ) KNIMES ==> Niveau (0,1,2) du Message;
00017 C                    KCODE  ==> CODE CORRESPONDANT A L'ACTION;
00018 C                    LDFATA ==> VRAI SI ON DOIT AVORTER LE PROGRAMME;
00019 C                    CDMESS ==> SI KNIMES#0, MESSAGE A EMETTRE;
00020 C                    CDNSPR ==> NOM DU SOUS-PROGRAMME APPELANT;
00021 C                    CDACTI ==> NOM DE L'ACTION D'ENTREE/SORTIE FORTRAN
00022 C                               (SI KCODE >0), SINON FOURRE-TOUT (!) .
00023 C*
00024 C        Pour la table des codes-reponses possibles, voir LFIEFR/LFIENG.
00025 C
00026 C
00027       TYPE(LFICOM) :: LFI
00028       INTEGER KNUMER, KNIMES, KCODE, ICODE, IREPON
00029 C
00030       LOGICAL LDFATA, LLEXUL
00031 C
00032       CHARACTER  CDNSPR*(*), CDMESS*(*), CDACTI*(*)
00033 #include "lficom_mt.h"
00034 C**
00035 C     1.  -  MODIFICATION EVENTUELLE DU CODE-REPONSE S'IL VAUT (-1).
00036 C-----------------------------------------------------------------------
00037 C*
00038 C        Il s'agit en effet de discriminer entre un numero d'unite
00039 C     logique licite pour le FORTRAN, mais effectivement non ouvert pour
00040 C     le logiciel LFI, auquel cas le code-reponse est laisse a (-1),
00041 C     et un numero d'unite logique FORTRAN carrement illicite, que l'on
00042 C     traduit par le code-reponse (-30).
00043 C
00044       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00045       IF (LHOOK) CALL DR_HOOK('LFIEMS_MT',0,ZHOOK_HANDLE)
00046       IF (KCODE.EQ.-1) THEN
00047         ICODE=-30
00048         INQUIRE (UNIT=KNUMER,EXIST=LLEXUL,ERR=101,IOSTAT=IREPON)
00049         IF (LLEXUL) ICODE=KCODE
00050       ELSE
00051         ICODE=KCODE
00052       ENDIF
00053 C
00054   101 CONTINUE
00055 C**
00056 C     2.  -  APPEL AU SOUS-PROGRAMME AD HOC EN FONCTION DE *LFI%LFRANC*.
00057 C-----------------------------------------------------------------------
00058 C
00059       IF (LFI%LFRANC) THEN
00060         CALL LFIEFR_MT (LFI, KNUMER,KNIMES,ICODE,LDFATA,
00061      S                  CDMESS,CDNSPR,CDACTI)
00062       ELSE
00063         CALL LFIENG_MT (LFI, KNUMER,KNIMES,ICODE,LDFATA,
00064      S                  CDMESS,CDNSPR,CDACTI)
00065       ENDIF
00066 C
00067       IF (LHOOK) CALL DR_HOOK('LFIEMS_MT',1,ZHOOK_HANDLE)
00068       END
00069