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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIREC_MT (LFI, KRGPIF, KRANG, KREC )
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     DETERMINATION DU LFI%NUMERO D'ENREGISTREMENT D'UNE PAIRE D'ARTICLES
00009 C     D'INDEX ( LFI%NUMERO DE L'ARTICLE "NOMS", EN FAIT ) .
00010 C**
00011 C    ARGUMENTS : KRGPIF (ENTREE) ==> RANG DE LA P.P.I. DANS LE FICHIER;
00012 C                KRANG  (ENTREE) ==> RANG DE L'UNITE DANS LFI%NUMERO.
00013 C                KREC   (SORTIE) ==> LFI%NUMERO D'ENREGISTREMENT DE LA P.A.I
00014 C
00015 #ifndef f77
00016 #include "precision.h"
00017 #endif
00018 C
00019       TYPE(LFICOM) :: LFI
00020       INTEGER KRGPIF, KRANG, KREC, INBPIR, INBALO, IFACTM, INALPP
00021       INTEGER ILARPH, INTPPI, IREP, INIMES, INUMER
00022 C
00023 #include "lficom2.h"
00024 #include "lficom_mt.h"
00025 C
00026       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00027       IF (LHOOK) CALL DR_HOOK('LFIREC_MT',0,ZHOOK_HANDLE)
00028       INBPIR=LFI%MDES1D(IXM(LFI%JPNPIR,KRANG))
00029       INBALO=LFI%MDES1D(IXM(LFI%JPNALO,KRANG))
00030       IFACTM=LFI%MFACTM(KRANG)
00031       INALPP=LFI%JPNAPP*IFACTM
00032       ILARPH=LFI%JPLARD*IFACTM
00033       INTPPI=(INBALO-1+INALPP)/INALPP
00034 C
00035       IF (KRGPIF.LE.INBPIR) THEN
00036         KREC=2*KRGPIF
00037       ELSEIF (KRGPIF.LE.INTPPI) THEN
00038 C
00039 C     CAS OU LES ARTICLES D'INDEX "RESERVES" A LA CREATION DU FICHIER
00040 C     N'ONT PAS SUFFI A STOCKER TOUS LES DESCRIPTEURS D'ARTICLES LOGI-
00041 C     QUES: L'EMPLACEMENT DES PAIRES D'ARTICLES D'INDEX EXCEDENTAIRES
00042 C     EST ALORS STOCKE DANS L'ARTICLE DOCUMENTAIRE, APRES LES VALEURS
00043 C     "UTILES" (LFI%JPLDOC MOTS), EN COMMENCANT PAR LA FIN DE CET ARTICLE.
00044 C       ( CECI POUR MENAGER UNE EVENTUELLE AUGMENTATION DE *LFI%JPLDOC*,
00045 C         EN CAS D'EVOLUTION DU LOGICIEL )
00046 C
00047         KREC=LFI%MDES1D(IXM(ILARPH+1-(KRGPIF-INBPIR),KRANG))
00048       ELSE
00049 C
00050 C          CAS OU IL Y A INCOHERENCE ENTRE TABLES ET ARGUMENTS D'APPEL
00051 C
00052         KREC=0
00053         IREP=-16
00054 C
00055 C        MESSAGERIE EVENTUELLE, AVEC ABORT SI NECESSAIRE .
00056 C
00057         LLFATA=LLMOER (IREP,KRANG)
00058 C
00059         IF (LLFATA.OR.LFI%NIMESG.NE.0) THEN
00060           INIMES=2
00061           CLNSPR='LFIREC'
00062           INUMER=LFI%NUMERO(KRANG)
00063 C
00064           IF (LFI%LFRANC) THEN
00065             WRITE (UNIT=CLMESS,FMT='(''KRGPIF='',I4,'', KRANG='
00066 ',I3,     S             '', KREC='',I6,'', CODE "INTERNE"='',I4)')
00067      S        KRGPIF,KRANG,KREC,IREP
00068           ELSE
00069             WRITE (UNIT=CLMESS,FMT='(''KRGPIF='',I4,'', KRANG='
00070 ',I3,     S             '', KREC='',I6,'', "INTERNAL" CODE='',I4)')
00071      S        KRGPIF,KRANG,KREC,IREP
00072           ENDIF
00073 C
00074           CALL LFIEMS_MT (LFI, INUMER,INIMES,IREP,LLFATA,
00075      S                    CLMESS,CLNSPR,CLACTI)
00076         ENDIF
00077 C
00078       ENDIF
00079 C
00080       IF (LHOOK) CALL DR_HOOK('LFIREC_MT',1,ZHOOK_HANDLE)
00081       END
00082