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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFINUM_MT (LFI, KNUMER, KRANG )
00003       USE LFIMOD, ONLY : LFICOM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        CE SOUS-PROGRAMME CALCULE LE RANG DU LFI%NUMERO D'UNITE LOGIQUE
00008 C     *KNUMER* DANS LA TABLE DES UNITES LOGIQUES *LFI%NUMERO*;
00009 C     S'IL N'Y EST PAS TROUVE, LE RESULTAT EST ZERO.
00010 C        CE SOUS-PROGRAMME, APPELE PAR *TOUS* LES SOUS-PROGRAMMES NON
00011 C     GLOBAUX DU LOGICIEL DE FICHIERS INDEXES LFI, SE CHARGE LORS DE SON
00012 C     PREMIER APPEL D'APPELER LE SOUS-PROGRAMME PREPARATOIRE LFIINI.
00013 C**
00014 C       ARGUMENTS : KNUMER (ENTREE) ==> LFI%NUMERO D'UNITE LOGIQUE CHERCHE;
00015 C                   KRANG  (SORTIE) ==> RANG DANS LA TABLE DES FICHIERS
00016 C                                       DU LOGICIEL LFI (0 SI ABSENT).
00017 C
00018 #ifndef f77
00019 #include "precision.h"
00020 #endif
00021 C
00022       TYPE(LFICOM) :: LFI
00023       INTEGER KNUMER, KRANG, J, IRESUL, IREP, INIMES
00024 #include "lficom_mt.h"
00025 C
00026       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00027       IF (LHOOK) CALL DR_HOOK('LFINUM_MT',0,ZHOOK_HANDLE)
00028       IF (LFI%LFINUM_LLPREA) THEN
00029         CALL LFIINI_MT (LFI, 2)
00030         LFI%LFINUM_LLPREA=.FALSE.
00031       ENDIF
00032 C
00033 C          VERROUILLAGE GLOBAL (A CAUSE DE L'UTILISATION DE LFI%NBFIOU )
00034 C
00035        IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'ON')
00036 C
00037       DO 10 J=1,LFI%NBFIOU
00038 C
00039       IF (KNUMER.EQ.LFI%NUMERO(LFI%NUMIND(J))) THEN
00040         IRESUL=LFI%NUMIND(J)
00041         GOTO 20
00042       ENDIF
00043 C
00044    10 CONTINUE
00045 C
00046       IRESUL=0
00047 C
00048    20 CONTINUE
00049 C
00050 C          DEVERROUILLAGE GLOBAL
00051 C
00052        IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'OFF')
00053       KRANG=IRESUL
00054 C**
00055 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00056 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00057 C-----------------------------------------------------------------------
00058 C
00059       IF (LFI%LMISOP) THEN
00060         IREP=0
00061         INIMES=2
00062         CLNSPR='LFINUM'
00063         WRITE (UNIT=CLMESS,FMT='(''KNUMER='',I3,'', KRANG='',I3)')
00064      S    KNUMER,KRANG
00065         CALL LFIEMS_MT (LFI, KNUMER,INIMES,IREP,.FALSE.,
00066      S                  CLMESS,CLNSPR,CLACTI)
00067       ENDIF
00068 C
00069       IF (LHOOK) CALL DR_HOOK('LFINUM_MT',1,ZHOOK_HANDLE)
00070       END
00071