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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIFMP_MT (LFI, KNUMER, KRANFM )
00003       USE LFIMOD, ONLY : LFICOM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        Sous-programme *INTERNE* du Logiciel de Fichiers Indexes LFI.
00008 C     Calcule le rang de l'unite logique *KNUMER* dans la table des
00009 C     Unites Logiques a Facteur Multiplicatif predefini;
00010 C     si l'Unite Logique n'y est pas trouvee, le resultat est ZERO.
00011 C
00012 C        En mode Multi-Taches, il est necessaire de verrouiller
00013 C     Globalement le code faisant appel a ce sous-programme.
00014 C**
00015 C       ARGUMENTS : KNUMER (Entree) ==> Numero d'unite logique cherche;
00016 C                   KRANFM (Sortie) ==> Rang dans la table des unites
00017 C                                       logiques a Facteur Multiplicatif
00018 C                                       predefini (0 si pas trouve).
00019 C
00020 #ifndef f77
00021 #include "precision.h"
00022 #endif
00023 C
00024       TYPE(LFICOM) :: LFI
00025       INTEGER KNUMER, KRANFM, J, IRANFM
00026 #include "lficom_mt.h"
00027 C**
00028 C     1.  -  RECHERCHE DIRECTE DANS LA TABLE *LFI%MULOFM*.
00029 C-----------------------------------------------------------------------
00030 C
00031       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00032       IF (LHOOK) CALL DR_HOOK('LFIFMP_MT',0,ZHOOK_HANDLE)
00033       DO 101 J=1,LFI%NULOFM
00034 C
00035       IF (KNUMER.EQ.LFI%MULOFM(J)) THEN
00036         IRANFM=J
00037         GOTO 102
00038       ENDIF
00039 C
00040   101 CONTINUE
00041 C
00042       IRANFM=0
00043 C
00044   102 CONTINUE
00045       KRANFM=IRANFM
00046 C
00047       IF (LHOOK) CALL DR_HOOK('LFIFMP_MT',1,ZHOOK_HANDLE)
00048       END
00049