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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FATALE_MT (FA,  KREP, KNUMER, LDERFA )
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 permet d'activer ou de desactiver l'option
00008 C     rendant fatale toute erreur detectee sur un fichier particulier,
00009 C     ouvert pour le Logiciel de Fichiers ARPEGE, de meme pour l'option
00010 C     correspondante du logiciel LFI.
00011 C        Cependant, tant que le niveau global d'erreur fatale *FA%NRFAGA*
00012 C     vaut 0 ou 2, l'option propre au fichier est inoperante.
00013 C     *FA%NRFAGA* vaut par defaut 1, et est reglable via le s/p "FANERG".
00014 C**
00015 C     Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
00016 C                 KNUMER (Entree) ==> Numero d'Unite Logique concernee;
00017 C                 LDERFA (Entree) ==> Option d'Erreur Fatale (Vrai=oui).
00018 C
00019 #include "precision.h"
00020 C
00021 C
00022       TYPE(FA_COM) :: FA
00023       INTEGER KREP, KNUMER
00024 C
00025       INTEGER IRANG, IREP, INIMES
00026 C
00027       LOGICAL LDERFA, LLRLFI
00028 C
00029 #include "facom2.h"
00030 #include "facom_mt.h"
00031 C
00032       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00033       IF (LHOOK) CALL DR_HOOK('FATALE_MT',0,ZHOOK_HANDLE)
00034       CALL FANUMU_MT (FA, KNUMER,IRANG)
00035 C
00036       IF (IRANG.NE.0) THEN
00037         FA%LERRFA(IRANG)=LDERFA
00038         CALL LFIERF_MT (FA%LFI, IREP,KNUMER,LDERFA)
00039         LLRLFI=IREP.NE.0
00040       ELSE
00041         IREP=-51
00042         LLRLFI=.FALSE.
00043       ENDIF
00044 C
00045       LLFATA=LLMOER (IREP,IRANG)
00046       KREP=IREP
00047 C
00048       IF (LLFATA.OR.IXNVMS (IRANG).EQ.2) THEN
00049         INIMES=2
00050       ELSE
00051         IF (LHOOK) CALL DR_HOOK('FATALE_MT',1,ZHOOK_HANDLE)
00052         RETURN
00053       ENDIF
00054 C
00055       CLNSPR='FATALE'
00056       WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
00057 ',I3,     S       '', LDERFA= '',L1)') KREP,KNUMER,LDERFA
00058       CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,LLFATA,CLMESS,
00059      S             CLNSPR,CLACTI,LLRLFI)
00060 C
00061       IF (LHOOK) CALL DR_HOOK('FATALE_MT',1,ZHOOK_HANDLE)
00062       END
00063