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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFINAF_MT (LFI, KREP, KNUMER, KNALDO, KNTROU, 
00003      S                      KNARES, KNAMAX )
00004       USE LFIMOD, ONLY : LFICOM
00005       USE PARKIND1, ONLY : JPRB
00006       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00007 C****
00008 C        SOUS-PROGRAMME DONNANT DES NOMBRES D'ARTICLES LOGIQUES DIVERS
00009 C     ( DE DONNEES, "TROUS", POSSIBLE, MAXIMUM ) POUR UNE UNITE LOGIQUE
00010 C     OUVERTE POUR LE LOGICIEL DE FICHIERS INDEXES *LFI* .
00011 C**
00012 C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
00013 C                KNUMER (ENTREE) ==> LFI%NUMERO DE L'UNITE LOGIQUE;
00014 C                KNALDO (SORTIE) ==> NOMBRE D'ARTICLES LOGIQUES
00015 C                                  *DE DONNEES* (TROUS EXCLUS) PRESENTS;
00016 C                KNTROU (SORTIE) ==> NOMBRE D'ARTICLES LOGIQUES QUI SONT
00017 C                                    DEVENUS DES "TROUS", PAR SUITE DE
00018 C                                    REECRITURES D'ARTICLES PLUS LONGUES
00019 C                                    QU'INITIALEMENT, ET QUI N'ONT PAS
00020 C                                    PU ETRE (ENCORE) RECYCLES;
00021 C                KNARES (SORTIE) ==> NOMBRE D'ARTICLES LOGIQUES POUVANT
00022 C                                    ETRE ECRITS DANS LA PARTIE "PRERER-
00023 C                                    VEE" DE L'INDEX (TROUS COMPRIS);
00024 C                KNAMAX (SORTIE) ==> NOMBRE D'ARTICLES LOGIQUES MAXIMUM
00025 C                                    POUVANT ETRE ECRITS SUR L'UNITE
00026 C                                    LOGIQUE, EN "DEBORDANT" AU MAXIMUM
00027 C                                   DE LA PARTIE PRERESERVEE DE L'INDEX.
00028 C                                    ( TROUS COMPRIS )
00029 C
00030 #ifndef f77
00031 #include "precision.h"
00032 #endif
00033 C
00034       TYPE(LFICOM) :: LFI
00035       INTEGER KREP, KNUMER, KNALDO, KNTROU, KNARES, KNAMAX
00036       INTEGER IRANG, IREP, IFACTM, ILARPH, INALPP, INIMES
00037 C
00038 #include "lficom2.h"
00039 #include "lficom_mt.h"
00040 C**
00041 C     1.  -  CONTROLES DU PARAMETRE D'APPEL, PUIS INITIALISATIONS.
00042 C-----------------------------------------------------------------------
00043 C
00044       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00045       IF (LHOOK) CALL DR_HOOK('LFINAF_MT',0,ZHOOK_HANDLE)
00046       CALL LFINUM_MT (LFI, KNUMER,IRANG)
00047 C
00048       IF (IRANG.EQ.0) THEN
00049         KNTROU=0
00050         KNALDO=0
00051         KNARES=0
00052         KNAMAX=0
00053         IREP=-1
00054         GOTO 1001
00055       ENDIF
00056 C
00057        IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'ON')
00058 C**
00059 C     2.  -  CALCUL DIRECT DES ARGUMENTS DE SORTIE DU SOUS-PROGRAMME.
00060 C-----------------------------------------------------------------------
00061 C
00062       IFACTM=LFI%MFACTM(IRANG)
00063       ILARPH=LFI%JPLARD*IFACTM
00064       INALPP=LFI%JPNAPP*IFACTM
00065       KNTROU=LFI%MDES1D(IXM(LFI%JPNTRU,IRANG))+LFI%NBTROU(IRANG)
00066       KNALDO=LFI%MDES1D(IXM(LFI%JPNALO,IRANG))-KNTROU
00067       KNARES=INALPP*LFI%MDES1D(IXM(LFI%JPNPIR,IRANG))
00068       KNAMAX=KNARES+INALPP*(ILARPH-LFI%JPLDOC)
00069       IREP=0
00070 C**
00071 C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
00072 C            VIA LE SOUS-PROGRAMME "LFIEMS" .
00073 C-----------------------------------------------------------------------
00074 C
00075  1001 CONTINUE
00076       KREP=IREP
00077       LLFATA=LLMOER (IREP,IRANG)
00078 C
00079       IF (IRANG.NE.0) THEN
00080         LFI%NDEROP(IRANG)=12
00081         LFI%NDERCO(IRANG)=IREP
00082          IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'OFF')
00083       ENDIF
00084 C
00085       IF (LLFATA.OR.IXNIMS (IRANG).EQ.2) THEN
00086         INIMES=2
00087       ELSE
00088         IF (LHOOK) CALL DR_HOOK('LFINAF_MT',1,ZHOOK_HANDLE)
00089         RETURN
00090       ENDIF
00091 C
00092       CLNSPR='LFINAF'
00093       WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
00094 ',I3,     S       '', KNALDO='',I6,'', KNTROU='',I6,'', KNARES='
00095 ',I6,     S       '', KNAMAX='',I6)') KREP,KNUMER,KNALDO,KNTROU,KNARES,KNAMAX
00096       CALL LFIEMS_MT (LFI, KNUMER,INIMES,IREP,LLFATA,
00097      S                CLMESS,CLNSPR,CLACTI)
00098 C
00099       IF (LHOOK) CALL DR_HOOK('LFINAF_MT',1,ZHOOK_HANDLE)
00100       END
00101