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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIVID_MT (LFI, KREP, KRANG, KNUMPD, KTAMPO, 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     "VIDAGE" SUR FICHIER D'UNE PAGE DE DONNEES, APRES L'AVOIR DUMENT
00009 C     COMPLETEE SI NECESSAIRE ( AVEC LES DONNEES DEJA PRESENTES SUR
00010 C     FICHIER, OU AVEC DES ZEROS DANS LE CAS DU DERNIER ARTICLE ).
00011 C**
00012 C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DE L'ECRITURE FORTRAN;
00013 C                KRANG  (ENTREE) ==> RANG EN MEMOIRE DE L'UNITE LOGIQUE;
00014 C                KNUMPD (ENTREE) ==> LFI%NUMERO DE LA PAGE DE DONNEES;
00015 C                KTAMPO (ENTREE) ==> ZONE SERVANT A RELIRE L'ARTICLE
00016 C                                    PHYSIQUE CORRESPONDANT SUR FICHIER,
00017 C                                    SI NECESSAIRE. (LONGUEUR: LFI%JPLARX)
00018 C                KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
00019 C
00020 #ifndef f77
00021 #include "precision.h"
00022 #endif
00023 C
00024       TYPE(LFICOM) :: LFI
00025       INTEGER KREP, KRANG, KNUMPD, KRETIN
00026 #ifndef f77
00027       INTEGER (KIND=JPDBLE)  KTAMPO (LFI%JPLARX)
00028 #else
00029       INTEGER KTAMPO (LFI%JPLARX)
00030 #endif
00031       INTEGER INUMER, ILONPD, INUMAE, IFACTM, ILARPH, JD, INAPHY, IRETOU
00032       INTEGER INIMES, IRETIN
00033 C
00034       LOGICAL LLADON
00035 C
00036 #include "lficom2.h"
00037 #include "lficom_mt.h"
00038 C**
00039 C     1.  -  CONTROLES ET INITIALISATIONS.
00040 C-----------------------------------------------------------------------
00041 C
00042       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00043       IF (LHOOK) CALL DR_HOOK('LFIVID_MT',0,ZHOOK_HANDLE)
00044       IF (KRANG.LE.0.OR.KRANG.GT.LFI%JPNXFI) THEN
00045         INUMER=LFI%JPNIL
00046       ELSE
00047         INUMER=LFI%NUMERO(KRANG)
00048         KREP=0
00049       ENDIF
00050 C
00051       IRETOU=0
00052 C
00053       IF (INUMER.EQ.LFI%JPNIL) THEN
00054         KREP=-14
00055         GOTO 1001
00056       ENDIF
00057 C
00058       ILONPD=LFI%NLONPD(KNUMPD,KRANG)
00059       INUMAE=LFI%NUMAPD(KNUMPD,KRANG)
00060       IFACTM=LFI%MFACTM(KRANG)
00061       ILARPH=LFI%JPLARD*IFACTM
00062 C**
00063 C     2.  -  COMPLEMENT EVENTUEL DE LA PAGE DE DONNEES A TRAITER.
00064 C-----------------------------------------------------------------------
00065 C
00066       IF (ILONPD.NE.ILARPH) THEN
00067 C
00068 C             PAGE DE DONNEES INSUFFISAMMENT REMPLIE.
00069 C
00070         IF (INUMAE.GT.LFI%MDES1D(IXM(LFI%JPAXPD,KRANG))) THEN
00071 C*
00072 C     2.1 -  PAS D'ARTICLE PHYSIQUE ASSOCIE SUR FICHIER,
00073 C            ON LA COMPLETE AVEC DES ZEROS.
00074 C-----------------------------------------------------------------------
00075 C
00076           DO 211 JD=ILONPD+1,ILARPH
00077           LFI%MTAMPD(IXT(JD,KNUMPD,KRANG))=0
00078   211     CONTINUE
00079 C
00080         ELSE
00081 C*
00082 C     2.2 -  NECESSITE D'ALLER RELIRE L'ARTICLE PHYSIQUE DE DONNEES
00083 C            SUR FICHIER, ET DE "RECOLLER LES MORCEAUX".
00084 C-----------------------------------------------------------------------
00085 C
00086           INAPHY=INUMAE
00087           CALL LFILDO_MT (LFI, KREP,INUMER,INUMAE,KTAMPO,
00088      S                    LFI%NBREAD(KRANG),IFACTM,IRETIN)
00089 C
00090           IF (IRETIN.NE.0) THEN
00091             GOTO 904
00092           ENDIF
00093 C
00094           DO 221 JD=ILONPD+1,ILARPH
00095           LFI%MTAMPD(IXT(JD,KNUMPD,KRANG))=KTAMPO(JD)
00096   221     CONTINUE
00097 C
00098         ENDIF
00099 C
00100       ENDIF
00101 C**
00102 C     3.  -  ECRITURE OU REECRITURE DE LA PAGE DE DONNEES COMPLETE
00103 C            OU COMPLETEE SUR FICHIER.
00104 C-----------------------------------------------------------------------
00105 C
00106       LLADON=.TRUE.
00107       INAPHY=0
00108       CALL LFIECX_MT (LFI, KREP,KRANG,INUMAE,
00109      S                LFI%MTAMPD(IXT(1,KNUMPD,KRANG)),LLADON,
00110      S                IRETIN)
00111 C
00112       IF (IRETIN.EQ.1) THEN
00113         GOTO 903
00114       ELSEIF (IRETIN.EQ.2) THEN
00115         GOTO 904
00116       ELSEIF (IRETIN.NE.0) THEN
00117         GOTO 1001
00118       ENDIF
00119 C
00120       LFI%LECRPD(KNUMPD,KRANG)=.FALSE.
00121       GOTO 1001
00122 C**
00123 C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
00124 C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
00125 C-----------------------------------------------------------------------
00126 C
00127   903 CONTINUE
00128       IRETOU=1
00129       CLACTI='WRITE'
00130       GOTO 909
00131 C
00132   904 CONTINUE
00133       IRETOU=2
00134       CLACTI='READ'
00135 C
00136   909 CONTINUE
00137       KREP=IABS (KREP)
00138       IF (INAPHY.NE.0) LFI%NUMAPH(KRANG)=INAPHY
00139 C**
00140 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00141 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00142 C-----------------------------------------------------------------------
00143 C
00144  1001 CONTINUE
00145       LLFATA=LLMOER (KREP,KRANG)
00146 C
00147       IF (KREP.EQ.0) THEN
00148         KRETIN=0
00149       ELSEIF (KREP.GT.0) THEN
00150         KRETIN=IRETOU
00151       ELSE
00152         KRETIN=3
00153       ENDIF
00154 C
00155       IF (LFI%LMISOP.OR.LLFATA) THEN
00156         INIMES=2
00157         CLNSPR='LFIVID'
00158         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='
00159 ',I3,     S         '', KNUMPD='',I3,'', KRETIN='',I2)')
00160      S     KREP,KRANG,KNUMPD,KRETIN
00161         CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE.,
00162      S                  CLMESS,CLNSPR,CLACTI)
00163       ENDIF
00164 C
00165       IF (LHOOK) CALL DR_HOOK('LFIVID_MT',1,ZHOOK_HANDLE)
00166       END
00167