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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFILCC_MT (LFI, KREP, KNUMER, KREC, CDTAB, 
00003      S                      KNBLEC, 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 Chaines de Caracteres
00009 C     du logiciel LFI (articles d'index "noms").
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 C
00027       CHARACTER CDTAB (LFI%JPNXNA*KFACTM)*(LFI%JPNCPN)
00028 #include "lficom_mt.h"
00029 C
00030 C        LECTURE .
00031 C
00032       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00033       IF (LHOOK) CALL DR_HOOK('LFILCC_MT',0,ZHOOK_HANDLE)
00034       READ (UNIT=KNUMER,REC=KREC,ERR=901,IOSTAT=KREP) CDTAB
00035 C
00036       IF (LFI%LMISOP) THEN
00037         WRITE (UNIT=LFI%NULOUT,FMT=*)
00038      S          '+++++ LFILCC - READ / ',KNUMER,', REC = ',KREC,
00039      S          ' +++++'
00040       ENDIF
00041 C
00042       KNBLEC=KNBLEC+1
00043       KRETIN=0
00044       GOTO 1001
00045 C
00046   901 CONTINUE
00047       KRETIN=2
00048 C
00049  1001 CONTINUE
00050 C
00051       IF (LHOOK) CALL DR_HOOK('LFILCC_MT',1,ZHOOK_HANDLE)
00052       END
00053