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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FANDAR_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 de definition d'une (Nouvelle) Date sur un fichier
00008 C     ARpege.
00009 C**
00010 C    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
00011 C                KNUMER (Entree) ==> Numero de l'unite logique;
00012 C     (Tableau)  KDATEF (Entree) ==> Date elle-meme (FA%JPLDAT mots).
00013 C*
00014 C        En cas de modification effective (si le fichier etait deja muni
00015 C     d'une date), il y a messagerie de niveau 1.
00016 C
00017 #include "precision.h"
00018 C
00019 C
00020       TYPE(FA_COM) :: FA
00021       INTEGER KREP, KNUMER
00022       INTEGER KDATEF (FA%JPLDAT)
00023       INTEGER (KIND=JPDBLE) KLDATEF (FA%JPLDAT)
00024 C
00025       INTEGER IRANG, IREP, INIMES, J
00026 C
00027       LOGICAL LLVERF, LLRLFI, LLMODA
00028 C
00029 #include "facom2.h"
00030 #include "facom_mt.h"
00031 C**
00032 C     1.  -  CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
00033 C-----------------------------------------------------------------------
00034 C
00035       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00036       IF (LHOOK) CALL DR_HOOK('FANDAR_MT',0,ZHOOK_HANDLE)
00037       LLVERF=.FALSE.
00038       LLRLFI=.FALSE.
00039       LLMODA=.FALSE.
00040       CALL FANUMU_MT (FA, KNUMER,IRANG)
00041 C
00042       IF (IRANG.EQ.0) THEN
00043         IREP=-51
00044         GOTO 1001
00045       ENDIF
00046 C
00047 C         Verrouillage eventuel du fichier.
00048 C
00049       IF (FA%LFAMUL) CALL LFIVER_MT (FA%LFI, FA%VRFICH(IRANG),'ON')
00050       LLVERF=FA%LFAMUL
00051 C**
00052 C     2.  -  DEFINITION PROPREMENT DITE VIA LE SOUS-PROGRAMME "FANDAI".
00053 C            ( controles, puis mise a jour de FA%MADATE(.,IRANG) )
00054 C-----------------------------------------------------------------------
00055 C
00056       CALL FANDAI_MT (FA, IREP,IRANG,KDATEF,LLMODA)
00057 C
00058       IF (IREP.EQ.0) THEN
00059 C**
00060 C     3.  -  ECRITURE DE LA DATE SUR LE FICHIER.
00061 C-----------------------------------------------------------------------
00062 C
00063         KLDATEF=KDATEF
00064         CALL LFIECR_MT (FA%LFI, IREP,KNUMER,FA%CPDATE,KLDATEF,FA%JPLDAT)
00065         LLRLFI=IREP.NE.0
00066         FA%LCREAF(IRANG)=FA%LCREAF(IRANG).AND.LLRLFI
00067       ENDIF
00068 C**
00069 C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
00070 C            VIA LE SOUS-PROGRAMME "FAIPAR" .
00071 C-----------------------------------------------------------------------
00072 C
00073  1001 CONTINUE
00074       KREP=IREP
00075       LLFATA=LLMOER (IREP,IRANG)
00076 C
00077 C        Deverrouillage eventuel du fichier.
00078 C
00079       IF (LLVERF) CALL LFIVER_MT (FA%LFI, FA%VRFICH(IRANG),'OFF')
00080 C
00081       IF (LLFATA) THEN
00082         INIMES=2
00083       ELSEIF (IREP.NE.0) THEN
00084         INIMES=0
00085       ELSE
00086         INIMES=IXNVMS(IRANG)
00087       ENDIF
00088 C
00089       IF (.NOT.LLFATA.AND.INIMES.EQ.0)  THEN 
00090         IF (LHOOK) CALL DR_HOOK('FANDAR_MT',1,ZHOOK_HANDLE)
00091         RETURN
00092       ENDIF
00093 C
00094       CLNSPR='FANDAR'
00095 C
00096       IF (INIMES.GE.1.AND.LLMODA) THEN
00097         WRITE (UNIT=CLMESS,FMT=
00098      S         '(''MODIFICATION DE LA DATE, UNITE'',I3)') KNUMER
00099         CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,.FALSE.,CLMESS,
00100      S                  CLNSPR,CLACTI,.FALSE.)
00101       ENDIF
00102 C
00103       IF (INIMES.EQ.2) THEN
00104 C***** FAZZZZ - KREP=iiii, KNUMER=iii, KDATEF(1:5)=iiiii/ii/ii iii:ii, *****
00105 C*****          KDATEF(7:8)=iiiiii-iiiiii                              *****
00106         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
00107 ',I3,     S       '', KDATEF(1:5)='',I5,2(''/'',I2),I3,'':'
00108 ',I2.2,     S       '', KDATEF(7:8)='',I6,''-'',I6)') KREP,KNUMER,
00109      S     (KDATEF(J),J=1,5),(KDATEF(J),J=7,8)
00110         CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,LLFATA,CLMESS,
00111      S               CLNSPR,CLACTI,LLRLFI)
00112       ENDIF
00113 C
00114       IF (LHOOK) CALL DR_HOOK('FANDAR_MT',1,ZHOOK_HANDLE)
00115       END
00116