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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFILDO_MT (LFI, KREP, KNUMER, KREC, KTAB, KNBLEC, 
00003      S                      KFACTM, KRETIN )
00004       USE LFIMOD, ONLY : LFICOM
00005       USE PARKIND1, ONLY : JPRB
00006       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00007 C****
00008 C        Sous-programme charge des Lectures de DOnnees du logiciel LFI,
00009 C     *SAUF* pour les articles d'index de type caractere.
00010 C**
00011 C     Arguments: KREP   (Sortie) ==> Code-reponse ( zero si OK; code-
00012 C                                    reponse du "READ" FORTRAN sinon);
00013 C                KNUMER (Entree) ==> NUMERo d'unite logique FORTRAN;
00014 C                KREC   (Entree) ==> Numero d'enregistrement a lire;
00015 C                KTAB   (Sortie) ==> Zone a lire, de Longueur
00016 C                                    LFI%JPLARD*KFACTM *mots*;
00017 C                KNBLEC (Entree  ==> Compteur de LECtures sur l'unite;
00018 C                       +Sortie)
00019 C                KFACTM (Entree) ==> FACteur Multiplicatif LFI de
00020 C                                    l'unite logique;
00021 C                KRETIN (Sortie) ==> Code-retour interne.
00022 C
00023 C
00024       TYPE(LFICOM) :: LFI
00025       INTEGER KREP, KNUMER, KREC, KNBLEC, KFACTM, KRETIN
00026 #ifndef f77
00027 #include "precision.h"
00028 C
00029       INTEGER (KIND=JPDBLE)  KTAB (LFI%JPLARD*KFACTM)
00030 #else
00031       INTEGER KTAB (LFI%JPLARD*KFACTM)
00032 #endif
00033 #include "lficom_mt.h"
00034 C
00035 C        LECTURE .
00036 C
00037       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00038       IF (LHOOK) CALL DR_HOOK('LFILDO_MT',0,ZHOOK_HANDLE)
00039       READ (UNIT=KNUMER,REC=KREC,ERR=901,IOSTAT=KREP) KTAB
00040 C
00041       IF (LFI%LMISOP) THEN
00042         WRITE (UNIT=LFI%NULOUT,FMT=*)
00043      S          '+++++ LFILDO - READ / ',KNUMER,', REC = ',KREC,
00044      S          ' +++++'
00045       ENDIF
00046 C
00047       KNBLEC=KNBLEC+1
00048       KRETIN=0
00049       GOTO 1001
00050 C
00051   901 CONTINUE
00052       KRETIN=2
00053 C
00054  1001 CONTINUE
00055 C
00056       IF (LHOOK) CALL DR_HOOK('LFILDO_MT',1,ZHOOK_HANDLE)
00057       END
00058