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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFINEG_MT (LFI, KNIVAU )
00003       USE LFIMOD, ONLY : LFICOM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        CE SOUS-PROGRAMME SE CHARGE DE METTRE LE NIVEAU GLOBAL D'ERREUR
00008 C     FATALE (*LFI%NERFAG*) A LA VALEUR KNIVAU . PAR  DEFAUT, LFI%NERFAG VAUT 1.
00009 C**
00010 C        ARGUMENT : KNIVAU (ENTREE) ==> NIVEAU GLOBAL D'ERREUR FATALE.
00011 C                                       VALEURS POSSIBLES
00012 C
00013 C     0 : RENDRE FATALE TOUTE ERREUR DETECTEE, MEME SI ELLE CORRESPOND
00014 C         A UN FICHIER OUVERT AVEC L'OPTION "PAS D'ERREUR FATALE".
00015 C     1 : NE REND FATALES QUE CERTAINES ERREURS "GLOBALES", C'EST-A-DIRE
00016 C         NON RELIABLES A UN FICHIER OUVERT, ET LES ERREURS SUR LES  FI-
00017 C         CHIERS OUVERTS AVEC L'OPTION "ERREUR FATALE" (MODE PAR DEFAUT)
00018 C     2 : PASSER OUTRE TOUTE ERREUR DETECTEE, MEME SI ELLE CORRESPOND
00019 C         A UN FICHIER OUVERT AVEC L'OPTION "ERREUR FATALE".
00020 C         NEANMOINS, LE CODE-REPONSE EVENTUEL NE SERA PAS ZERO.
00021 C
00022 #ifndef f77
00023 #include "precision.h"
00024 #endif
00025 C
00026       TYPE(LFICOM) :: LFI
00027       INTEGER KNIVAU, INIMES, IREP, INUMER
00028 #include "lficom_mt.h"
00029 C
00030       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00031       IF (LHOOK) CALL DR_HOOK('LFINEG_MT',0,ZHOOK_HANDLE)
00032       IF (LFI%LFINEG_LLPREA) THEN
00033         CALL LFIINI_MT (LFI, 2)
00034         LFI%LFINEG_LLPREA=.FALSE.
00035       ENDIF
00036 C
00037       IF (KNIVAU.GE.0.AND.KNIVAU.LE.2) THEN
00038         LFI%NERFAG=KNIVAU
00039         IREP=0
00040       ELSE
00041         IREP=-2
00042       ENDIF
00043 C
00044       LLFATA=IREP.NE.0.AND.LFI%NERFAG.NE.2
00045 C
00046       IF (LLFATA) THEN
00047         INIMES=2
00048       ELSEIF (IREP.NE.0) THEN
00049         INIMES=0
00050       ELSEIF (LFI%NIMESG.EQ.2) THEN
00051         INIMES=2
00052       ELSE
00053         IF (LHOOK) CALL DR_HOOK('LFINEG_MT',1,ZHOOK_HANDLE)
00054         RETURN
00055       ENDIF
00056 C
00057       INUMER=LFI%JPNIL
00058       CLNSPR='LFINEG'
00059 C
00060       IF (MAX0 (INIMES,LFI%NIMESG).EQ.2) THEN
00061 C
00062         IF (LFI%LFRANC) THEN
00063           WRITE (UNIT=CLMESS,
00064      S           FMT='(''KNIVAU='',I5,'', CODE INTERNE='
00065 ',     S           I4)') KNIVAU,IREP
00066         ELSE
00067           WRITE (UNIT=CLMESS,
00068      S           FMT='(''KNIVAU='',I5,'', INTERNAL CODE='
00069 ',     S           I4)') KNIVAU,IREP
00070         ENDIF
00071 C
00072         IF (INIMES.NE.2) CALL LFIEMS_MT (LFI, INUMER,LFI%NIMESG,IREP,
00073      S                                   .FALSE.,CLMESS,
00074      S                                   CLNSPR,CLACTI)
00075       ENDIF
00076 C
00077       CALL LFIEMS_MT (LFI, INUMER,INIMES,IREP,LLFATA,
00078      S                CLMESS,CLNSPR,CLACTI)
00079 C
00080       IF (LHOOK) CALL DR_HOOK('LFINEG_MT',1,ZHOOK_HANDLE)
00081       END
00082