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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002 C R. El Khatib 30-Mar-2012 KULOUT
00003       SUBROUTINE FANMSG_MT (FA,  KNIVAU, KULOUT )
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 se charge de mettre le Niveau Global d'
00009 C     impression des Messages du logiciel de Fichiers ARPEGE (*FA%NIMSGA*)
00010 C     a la valeur KNIVAU, de meme que la variable correspondante du
00011 C     du logiciel LFI. Par defaut, FA%NIMSGA vaut 1.
00012 C**
00013 C        Argument : KNIVAU (Entree) ==> Niveau Global d'Impression
00014 C                                       des Messages.
00015 C                                       Valeurs possibles:
00016 C
00017 C     0 : N'emettre que les messages d'erreurs reellement importants .
00018 C     1 : N'emettre qu'un minimum de messages "globaux", et les messages
00019 C         lies a un fichier ouvert qui sont de niveau au plus egal au
00020 C         niveau de la messagerie pour ce fichier (Mode par defaut) .
00021 C     2 : Emettre tous les messages possibles, meme s'ils ne correspon-
00022 C         dent pas a un fichier ouvert avec le niveau de Messagerie 2 .
00023 C
00024 C                   KULOUT : logical unit number for printing
00025 C
00026 #include "precision.h"
00027 C
00028 C
00029       TYPE(FA_COM) :: FA
00030       INTEGER KNIVAU
00031       INTEGER KULOUT
00032 C
00033       INTEGER IREP, INIMES, INUMER
00034 #include "facom_mt.h"
00035 C
00036 C
00037       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00038 
00039       IF (LHOOK) CALL DR_HOOK('FANMSG_MT',0,ZHOOK_HANDLE)
00040 
00041       IF (FA%FANMSG_LLPREA) THEN
00042         CALL FARINE_MT (FA, 2)
00043         FA%FANMSG_LLPREA=.FALSE.
00044       ENDIF
00045 C
00046       IF (KNIVAU.GE.0.AND.KNIVAU.LE.2) THEN
00047         INIMES=MAX (FA%NIMSGA,KNIVAU)
00048         FA%NIMSGA=KNIVAU
00049         CALL LFINMG_MT (FA%LFI, KNIVAU,KULOUT)
00050         IREP=0
00051       ELSE
00052         INIMES=FA%NIMSGA
00053         IREP=-52
00054       ENDIF
00055 C
00056       LLFATA=IREP.NE.0.AND.FA%NRFAGA.NE.2
00057 C
00058       IF (LLFATA) THEN
00059         INIMES=2
00060       ELSEIF (IREP.NE.0) THEN
00061         INIMES=0
00062       ELSEIF (INIMES.NE.2) THEN
00063         IF (LHOOK) CALL DR_HOOK('FANMSG_MT',1,ZHOOK_HANDLE)
00064         RETURN
00065       ENDIF
00066 C
00067       INUMER=FA%JPNIIL
00068       CLNSPR='FANMSG'
00069 C
00070       IF (MAX (INIMES,FA%NIMSGA).EQ.2) THEN
00071         WRITE (UNIT=CLMESS,
00072      S         FMT='(''KNIVAU='',I5,'', CODE INTERNE='',I4)'
00073      S         ) KNIVAU,IREP
00074         IF (INIMES.NE.2) CALL FAIPAR_MT (FA, INUMER,FA%NIMSGA,IREP,
00075      S                                .FALSE.,CLMESS,
00076      S                                CLNSPR,CLACTI,.FALSE.)
00077       ENDIF
00078 C
00079       CALL FAIPAR_MT (FA, INUMER,INIMES,IREP,LLFATA,CLMESS,
00080      S             CLNSPR,CLACTI,
00081      S             .FALSE.)
00082 C
00083       IF (LHOOK) CALL DR_HOOK('FANMSG_MT',1,ZHOOK_HANDLE)
00084       END