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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FANERG_MT (FA,  KNIVAU )
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 se charge de mettre le Niveau Global d'Erreur
00008 C     Fatale du logiciel de Fichiers ARPEGE (*FA%NRFAGA*) a la valeur
00009 C     KNIVAU, de meme que la variable correspondante du logiciel LFI.
00010 C     Par defaut, FA%NRFAGA vaut 1.
00011 C**
00012 C        Argument : KNIVAU (Entree) ==> Niveau global d'erreur fatale.
00013 C                                       Valeurs possibles:
00014 C
00015 C     0 : Rendre fatale toute erreur detectee, meme si elle correspond
00016 C         a un fichier ouvert avec l'option "pas d'erreur fatale".
00017 C     1 : Ne rend fatales que certaines erreurs "globales", c'est-a-dire
00018 C         non reliables a un fichier ouvert, et les erreurs sur les fi-
00019 C         chiers ouverts avec l'option "erreur fatale" (Mode par defaut)
00020 C     2 : Passer outre toute erreur detectee, meme si elle correspond
00021 C         a un fichier ouvert avec l'option "erreur fatale".
00022 C         Neanmoins, le code-reponse eventuel ne sera pas zero.
00023 C
00024 #include "precision.h"
00025 C
00026 C
00027       TYPE(FA_COM) :: FA
00028       INTEGER KNIVAU
00029 C
00030       INTEGER IREP, INIMES, INUMER
00031 #include "facom_mt.h"
00032 C
00033 C
00034       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00035       IF (LHOOK) CALL DR_HOOK('FANERG_MT',0,ZHOOK_HANDLE)
00036       IF (FA%FANERG_LLPREA) THEN
00037         CALL FARINE_MT (FA, 2)
00038         FA%FANERG_LLPREA=.FALSE.
00039       ENDIF
00040 C
00041       IF (KNIVAU.GE.0.AND.KNIVAU.LE.2) THEN
00042         FA%NRFAGA=KNIVAU
00043         CALL LFINEG_MT (FA%LFI, KNIVAU)
00044         IREP=0
00045       ELSE
00046         IREP=-52
00047       ENDIF
00048 C
00049       LLFATA=IREP.NE.0.AND.FA%NRFAGA.NE.2
00050 C
00051       IF (LLFATA) THEN
00052         INIMES=2
00053       ELSEIF (IREP.NE.0) THEN
00054         INIMES=0
00055       ELSEIF (FA%NIMSGA.EQ.2) THEN
00056         INIMES=2
00057       ELSE
00058         IF (LHOOK) CALL DR_HOOK('FANERG_MT',1,ZHOOK_HANDLE)
00059         RETURN
00060       ENDIF
00061 C
00062       INUMER=FA%JPNIIL
00063       CLNSPR='FANERG'
00064 C
00065       IF (MAX (INIMES,FA%NIMSGA).EQ.2) THEN
00066         WRITE (UNIT=CLMESS,
00067      S         FMT='(''KNIVAU='',I5,'', CODE INTERNE='',I4)'
00068      S         ) KNIVAU,IREP
00069       ENDIF
00070 C
00071       CALL FAIPAR_MT (FA, INUMER,INIMES,IREP,LLFATA,CLMESS,
00072      S             CLNSPR,CLACTI,.FALSE.)
00073 C
00074       IF (LHOOK) CALL DR_HOOK('FANERG_MT',1,ZHOOK_HANDLE)
00075       END
00076