SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/FA/mt/fadies

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FADIES_MT (FA,  KREP, KNUMER, KDATEF )
00003       USE FA_MOD, ONLY : FA_COM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C      Sous-programme permettant d'obtenir la date d'un fichier ouvert
00008 C     pour le logiciel de Fichiers ARPEGE, et deja muni d'une date.
00009 C     ( "DIES" = jour en latin... )
00010 C**
00011 C    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
00012 C                KNUMER (Entree) ==> Numero de l'unite logique;
00013 C     (Tableau)  KDATEF (Sortie) ==> Date elle-meme (FA%JPLDAT mots).
00014 C
00015 #include "precision.h"
00016 C
00017 C
00018       TYPE(FA_COM) :: FA
00019       INTEGER KREP, KNUMER
00020       INTEGER KDATEF (FA%JPLDAT)
00021 C
00022       INTEGER IRANG, J, IREP, INIMES
00023 C
00024       LOGICAL LLVERF
00025 C
00026 #include "facom2.h"
00027 #include "facom_mt.h"
00028 C**
00029 C     1.  -  CONTROLES DES PARAMETRES D'APPEL, ET INITIALISATIONS.
00030 C-----------------------------------------------------------------------
00031 C
00032       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00033       IF (LHOOK) CALL DR_HOOK('FADIES_MT',0,ZHOOK_HANDLE)
00034       LLVERF=.FALSE.
00035       CALL FANUMU_MT (FA, KNUMER,IRANG)
00036 C
00037       IF (IRANG.EQ.0) THEN
00038         IREP=-51
00039         GOTO 1001
00040       ENDIF
00041 C
00042 C         Verrouillage eventuel du fichier.
00043 C
00044       IF (FA%LFAMUL) CALL LFIVER_MT (FA%LFI, FA%VRFICH(IRANG),'ON')
00045       LLVERF=FA%LFAMUL
00046 C**
00047 C     2.  -  CONTROLE DE DEFINITION PREALABLE DE LA DATE.
00048 C-----------------------------------------------------------------------
00049 C
00050       IF (FA%LCREAF(IRANG)) THEN
00051         IREP=-85
00052         GOTO 1001
00053       ENDIF
00054 C**
00055 C     3.  -  TRANSFERT DE LA TABLE "FA%MADATE" DANS LE TABLEAU ARGUMENT.
00056 C-----------------------------------------------------------------------
00057 C
00058       DO 301 J=1,FA%JPLDAT
00059       KDATEF(J)=FA%MADATE(J,IRANG)
00060   301 CONTINUE
00061 C
00062       IREP=0
00063 C**
00064 C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
00065 C            VIA LE SOUS-PROGRAMME "FAIPAR" .
00066 C-----------------------------------------------------------------------
00067 C
00068  1001 CONTINUE
00069       KREP=IREP
00070       LLFATA=LLMOER (IREP,IRANG)
00071 C
00072 C        Deverrouillage eventuel du fichier.
00073 C
00074       IF (LLVERF) CALL LFIVER_MT (FA%LFI, FA%VRFICH(IRANG),'OFF')
00075 C
00076       IF (LLFATA.OR.IXNVMS(IRANG).EQ.2) THEN
00077         INIMES=2
00078       ELSE
00079         IF (LHOOK) CALL DR_HOOK('FADIES_MT',1,ZHOOK_HANDLE)
00080         RETURN
00081       ENDIF
00082 C
00083       CLNSPR='FADIES'
00084 C
00085       IF (INIMES.EQ.2) THEN
00086         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
00087 ',I3,     S       '', KDATEF(1:5)='',I5,2(''/'',I2),I3,'':'
00088 ',I2.2,     S       '', KDATEF(7:8)='',I6,''-'',I6)') KREP,KNUMER,
00089      S     (KDATEF(J),J=1,5),(KDATEF(J),J=7,8)
00090         CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,LLFATA,CLMESS,
00091      S               CLNSPR,CLACTI,.FALSE.)
00092       ENDIF
00093 C
00094       IF (LHOOK) CALL DR_HOOK('FADIES_MT',1,ZHOOK_HANDLE)
00095       END
00096