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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FANIME_MT (FA,  KREP, KNUMER, KNIMES )
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'ajuster le Niveau de Messagerie
00008 C     propre aux actions faites sur un fichier particulier, ouvert pour
00009 C     le Logiciel de Fichiers ARPEGE, de meme que le Niveau correspon-
00010 C     dant du logiciel LFI.
00011 C        Cependant, tant que le Niveau de Messagerie Global *FA%NIMSGA*
00012 C     vaut 0 ou 2, le niveau propre au fichier est inoperant.
00013 C     *FA%NIMSGA* vaut par defaut 1, et est reglable via le s/p "FANMSG".
00014 C**
00015 C     Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
00016 C                 KNUMER (Entree) ==> Numero d'Unite Logique concernee;
00017 C                 KNIMES (Entree) ==> Niveau de Messagerie souhaite.
00018 C
00019 #include "precision.h"
00020 C
00021 C
00022       TYPE(FA_COM) :: FA
00023       INTEGER KREP, KNUMER, KNIMES
00024 C
00025       INTEGER IREP, IRANG, INIMEX, ILACTI, INIMES
00026 C
00027       LOGICAL 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('FANIME_MT',0,ZHOOK_HANDLE)
00034       CALL FANUMU_MT (FA, KNUMER,IRANG)
00035       INIMEX=0
00036 C
00037       IF (IRANG.EQ.0) THEN
00038         IREP=-51
00039       ELSEIF (KNIMES.GE.0.AND.KNIMES.LE.2) THEN
00040         INIMEX=IXNVMS (IRANG)
00041         FA%NIVOMS(IRANG)=KNIMES
00042         CALL LFINIM_MT (FA%LFI, IREP,KNUMER,KNIMES)
00043         LLRLFI=IREP.NE.0
00044       ELSE
00045         IREP=-52
00046       ENDIF
00047 C
00048       KREP=IREP
00049       LLFATA=LLMOER (IREP,IRANG)
00050 C
00051       IF (LLFATA.OR.MAX (IXNVMS (IRANG),INIMEX).EQ.2) THEN
00052         INIMES=2
00053       ELSE
00054         IF (LHOOK) CALL DR_HOOK('FANIME_MT',1,ZHOOK_HANDLE)
00055         RETURN
00056       ENDIF
00057 C
00058       CLNSPR='FANIME'
00059       WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
00060 ',I3,     S       '', KNIMES='',I3)') KREP,KNUMER,KNIMES
00061       CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,LLFATA,CLMESS,
00062      S             CLNSPR,CLACTI,.FALSE.)
00063 C
00064       IF (LHOOK) CALL DR_HOOK('FANIME_MT',1,ZHOOK_HANDLE)
00065       END
00066