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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIMST_MT (LFI, KREP, KNUMER, LDIMST )
00003       USE LFIMOD, ONLY : LFICOM
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     D'IMPRESSION DE STATISTIQUES A LA FERMETURE D'UN FICHIER
00009 C     PARTICULIER, OUVERT POUR LE LOGICIEL LFI.
00010 C        CEPENDANT, TANT QUE LE NIVEAU GLOBAL D'IMPRESSION DES STAT.
00011 C     *LFI%NISTAG* VAUT 0 OU 2, L'OPTION PROPRE AU FICHIER EST INOPERANTE.
00012 C     *LFI%NISTAG* VAUT PAR DEFAUT 1, ET EST REGLABLE VIA LE S/P "LFINSG".
00013 C**
00014 C     ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
00015 C                 KNUMER (ENTREE) ==> LFI%NUMERO D'UNITE LOGIQUE CONCERNEE;
00016 C                 LDIMST (ENTREE) ==> OPTION D'IMPRESSION (VRAI=OUI)
00017 C
00018 #ifndef f77
00019 #include "precision.h"
00020 #endif
00021 C
00022       TYPE(LFICOM) :: LFI
00023       INTEGER KREP, KNUMER, IRANG, IREP, INIMES
00024 C
00025       LOGICAL LDIMST
00026 C
00027 #include "lficom2.h"
00028 #include "lficom_mt.h"
00029 C
00030       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00031       IF (LHOOK) CALL DR_HOOK('LFIMST_MT',0,ZHOOK_HANDLE)
00032       CALL LFINUM_MT (LFI, KNUMER,IRANG)
00033 C
00034       IF (IRANG.NE.0) THEN
00035          IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'ON')
00036         LFI%LISTAT(IRANG)=LDIMST
00037         LFI%NDEROP(IRANG)=3
00038          IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'OFF')
00039         IREP=0
00040       ELSE
00041         IREP=-1
00042       ENDIF
00043 C
00044       KREP=IREP
00045       LLFATA=LLMOER (IREP,IRANG)
00046 C
00047       IF (LLFATA.OR.IXNIMS (IRANG).EQ.2) THEN
00048         INIMES=2
00049       ELSE
00050         IF (LHOOK) CALL DR_HOOK('LFIMST_MT',1,ZHOOK_HANDLE)
00051         RETURN
00052       ENDIF
00053 C
00054       CLNSPR='LFIMST'
00055       WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
00056 ',I3,     S       '', LDIMST= '',L1)') KREP,KNUMER,LDIMST
00057       CALL LFIEMS_MT (LFI, KNUMER,INIMES,IREP,LLFATA,
00058      S                CLMESS,CLNSPR,CLACTI)
00059 C
00060       IF (LHOOK) CALL DR_HOOK('LFIMST_MT',1,ZHOOK_HANDLE)
00061       END
00062