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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIPHA_MT (LFI, KREP, KRANG, KRGPIM, KRETIN )
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     PHASAGE D'UNE PAGE D'INDEX "LONGUEUR/POSITION"
00009 C     AVEC LA PAGE D'INDEX "NOMS" CORRESPONDANTE.
00010 C        IL EST ABSOLUMENT NECESSAIRE QUE LA PAGE D'INDEX "NOMS" SOIT
00011 C     EFFECTIVEMENT ALIMENTEE AVANT L'APPEL DE CE SOUS-PROGRAMME...
00012 C**
00013 C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DE LA LECTURE DE PAGE;
00014 C                KRANG  (ENTREE) ==> RANG DE L'UNITE LOGIQUE CONCERNEE;
00015 C                KRGPIM (ENTREE) ==> LFI%NUMERO DE LA PAGE CONCERNEE;
00016 C                KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
00017 C
00018 #ifndef f77
00019 #include "precision.h"
00020 #endif
00021 C
00022       TYPE(LFICOM) :: LFI
00023       INTEGER KREP, KRANG, KRGPIM, KRETIN, INUMER, IREC, INAPHY, INIMES
00024       INTEGER IRETOU, IRETIN
00025 C
00026 #include "lficom2.h"
00027 #include "lficom_mt.h"
00028 C
00029       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00030       IF (LHOOK) CALL DR_HOOK('LFIPHA_MT',0,ZHOOK_HANDLE)
00031       IRETOU=0
00032       INUMER=LFI%NUMERO(KRANG)
00033       CALL LFIREC_MT (LFI, LFI%MRGPIF(KRGPIM),KRANG,IREC)
00034       INAPHY=IREC+1
00035       CALL LFILDO_MT (LFI, KREP,INUMER,IREC+1,LFI%MLGPOS(IXM(1,KRGPIM)),
00036      S             LFI%NBREAD(KRANG),LFI%MFACTM(KRANG),IRETIN)
00037 C
00038       IF (IRETIN.NE.0) THEN
00039         GOTO 904
00040       ENDIF
00041 C
00042       LFI%LPHASP(KRGPIM)=.TRUE.
00043       GOTO 1001
00044 C
00045   904 CONTINUE
00046       IRETOU=2
00047       CLACTI='READ'
00048 C
00049 C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
00050 C
00051       KREP=IABS (KREP)
00052       LFI%NUMAPH(KRANG)=INAPHY
00053 C**
00054 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00055 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00056 C-----------------------------------------------------------------------
00057 C
00058  1001 CONTINUE
00059       LLFATA=LLMOER (KREP,KRANG)
00060 C
00061       IF (KREP.EQ.0) THEN
00062         KRETIN=0
00063       ELSEIF (KREP.GT.0) THEN
00064         KRETIN=IRETOU
00065       ELSE
00066         KRETIN=3
00067       ENDIF
00068 C
00069       IF (LFI%LMISOP.OR.LLFATA) THEN
00070         INIMES=2
00071         CLNSPR='LFIPHA'
00072         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='
00073 ',I3,     S         '', KRGPIM='',I3,'', KRETIN='',I2)')
00074      S    KREP,KRANG,KRGPIM,KRETIN
00075         CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE.,
00076      S                  CLMESS,CLNSPR,CLACTI)
00077       ENDIF
00078 C
00079       IF (LHOOK) CALL DR_HOOK('LFIPHA_MT',1,ZHOOK_HANDLE)
00080       END
00081