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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIMOE_MT ( LFI, KREP, KRANG, 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     MODIFICATION DE L'ARTICLE DOCUMENTAIRE, LIMITEE A 3 ELEMENTS,
00009 C     LORSQUE LE FICHIER A SUBI SA PREMIERE MODIFICATION DEPUIS LA
00010 C     DERNIERE OUVERTURE.
00011 C
00012 C     APPELE PAR LFIECR, LFIREN, LFISUP.
00013 C**
00014 C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
00015 C                KRANG  (ENTREE) ==> RANG ( DANS LA TABLE *LFI%NUMERO* )
00016 C                                    DE L'UNITE LOGIQUE CONCERNEE;
00017 C                KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
00018 C
00019 #ifndef f77
00020 #include "precision.h"
00021 #endif
00022 C
00023       TYPE(LFICOM) :: LFI
00024 #ifndef f77
00025       INTEGER (KIND=JPDBLE) IDESCR (LFI%JPLARX)
00026 #else
00027       INTEGER IDESCR (LFI%JPLARX)
00028 #endif
00029       INTEGER KREP, KRANG, KRETIN, INUMER, IFACTM, IREC
00030       INTEGER IRANG, INAPHY, IRETOU, INIMES, IRETIN
00031 C
00032 #include "lficom2.h"
00033 #include "lficom_mt.h"
00034 C**
00035 C     1. -  CONTROLES DES PARAMETRES D'APPEL ET INITIALISATIONS.
00036 C-----------------------------------------------------------------------
00037 C
00038       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00039       IF (LHOOK) CALL DR_HOOK('LFIMOE_MT',0,ZHOOK_HANDLE)
00040       IRETOU=0
00041 C
00042       IF (KRANG.LE.0.OR.KRANG.GT.LFI%JPNXFI) THEN
00043         KREP=-16
00044         GOTO 1001
00045       ENDIF
00046 C
00047       IRANG=KRANG
00048       KREP=0
00049       INUMER=LFI%NUMERO(IRANG)
00050       IFACTM=LFI%MFACTM(IRANG)
00051       IREC=1
00052 C**
00053 C     2. -  LECTURE/MODIFICATION/REECRITURE DE L'ARTICLE DOCUMENTAIRE.
00054 C-----------------------------------------------------------------------
00055 C
00056       INAPHY=IREC
00057       CALL LFILDO_MT (LFI, KREP,INUMER,IREC,IDESCR(1),
00058      S                LFI%NBREAD(IRANG),IFACTM,IRETIN)
00059 C
00060       IF (IRETIN.NE.0) THEN
00061         GOTO 904
00062       ENDIF
00063 C
00064       IDESCR(LFI%JPFEAM)=1
00065       CALL LFIDAH_MT (LFI, IDESCR(LFI%JPDMNG),IDESCR(LFI%JPHMNG))
00066       LFI%MDES1D(IXM(LFI%JPDMNG,IRANG))=IDESCR(LFI%JPDMNG)
00067       LFI%MDES1D(IXM(LFI%JPHMNG,IRANG))=IDESCR(LFI%JPHMNG)
00068       CALL LFIEDO_MT (LFI, KREP,INUMER,IREC,IDESCR(1),
00069      S                LFI%NBWRIT(IRANG),IFACTM,IRETIN)
00070 C
00071       IF (IRETIN.NE.0) THEN
00072         GOTO 903
00073       ENDIF
00074 C
00075       GOTO 1001
00076 C**
00077 C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
00078 C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
00079 C-----------------------------------------------------------------------
00080 C
00081   903 CONTINUE
00082       IRETOU=1
00083       CLACTI='WRITE'
00084       GOTO 909
00085 C
00086   904 CONTINUE
00087       IRETOU=2
00088       CLACTI='READ'
00089 C
00090   909 CONTINUE
00091       KREP=IABS (KREP)
00092       LFI%NUMAPH(IRANG)=INAPHY
00093 C**
00094 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00095 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00096 C-----------------------------------------------------------------------
00097 C
00098  1001 CONTINUE
00099       LLFATA=LLMOER (KREP,KRANG)
00100 C
00101       IF (KREP.EQ.0) THEN
00102         KRETIN=0
00103       ELSEIF (KREP.GT.0) THEN
00104         KRETIN=IRETOU
00105       ELSE
00106         KRETIN=3
00107       ENDIF
00108 C
00109       IF (LFI%LMISOP.OR.LLFATA) THEN
00110         INUMER=LFI%NUMERO(KRANG)
00111         INIMES=2
00112         CLNSPR='LFIMOE'
00113         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='
00114 ',I3,     S  '', KRETIN='',I2)')
00115      S    KREP,KRANG,KRETIN
00116         CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE.,
00117      S                  CLMESS,CLNSPR,CLACTI)
00118       ENDIF
00119 C
00120       IF (LHOOK) CALL DR_HOOK('LFIMOE_MT',1,ZHOOK_HANDLE)
00121       END
00122