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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FANDAI_MT (FA,  KREP, KRANG, KDATEF, LDMODA )
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 INTERNE du logiciel de Fichiers ARPEGE:
00008 C     Definition d'une (Nouvelle) Date.
00009 C**
00010 C    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
00011 C                KRANG  (Entree) ==> Rang de l'unite logique;
00012 C     (Tableau)  KDATEF (Entree) ==> Date elle-meme (FA%JPLDAT mots).
00013 C                LDMODA (Sortie) ==> Vrai s'il y a modification d'une
00014 C                                    date deja definie.
00015 C*
00016 C       En mode multi-taches, il doit y avoir verrouillage du fichier
00017 C     concerne avant l'appel au sous-programme.
00018 C
00019 #include "precision.h"
00020 C
00021 C
00022       TYPE(FA_COM) :: FA
00023       INTEGER KREP, KRANG
00024       INTEGER KDATEF (FA%JPLDAT)
00025 C
00026       INTEGER IMI123, IMAX69, IMINIM, J, ILMOIS, IDEBUT, INIMES, INUMER
00027 C
00028       LOGICAL LDMODA
00029 C
00030 #include "facom2.h"
00031 #include "facom_mt.h"
00032 C**
00033 C     1.  -  CONTROLES DES PARAMETRES D'APPEL.
00034 C-----------------------------------------------------------------------
00035 C
00036       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00037       IF (LHOOK) CALL DR_HOOK('FANDAI_MT',0,ZHOOK_HANDLE)
00038       LDMODA=.FALSE.
00039 C
00040       IF (KRANG.LE.0.OR.KRANG.GT.FA%JPNXFA) THEN
00041         KREP=-66
00042         GOTO 1001
00043       ENDIF
00044 C
00045 C         Controle de la Date proprement dite.
00046 C
00047       IMI123=MIN (KDATEF(1),KDATEF(2),KDATEF(3))
00048       IMAX69=MAX (KDATEF(6),KDATEF(9))
00049       IMINIM=KDATEF(1)
00050 C
00051       DO 103 J=2,FA%JPLDAT
00052       IMINIM=MIN (IMINIM,KDATEF(J))
00053   103 CONTINUE
00054 C
00055       IF (IMINIM.LT.0.OR.IMI123.LE.0.OR.KDATEF(2).GT.12.OR.
00056      S    KDATEF(3).GT.31.OR.KDATEF(4).GT.24.OR.KDATEF(5).GE.60.OR.
00057      S    IMAX69.GE.255.OR.
00058      S (KDATEF(10).LE.KDATEF(11).AND.(KDATEF(10)*KDATEF(11)).NE.0)) THEN
00059 C
00060 C        Erreur de syntaxe.
00061 C
00062         KREP=-82
00063         GOTO 1001
00064       ELSEIF ((KDATEF(2).GT.7.OR.MOD (KDATEF(2),2).EQ.0).AND.
00065      S        (KDATEF(2).LE.7.OR.MOD (KDATEF(2),2).EQ.1)) THEN
00066 C
00067 C        Controle de coherence (annee,mois,jour).
00068 C
00069         IF (KDATEF(2).EQ.2) THEN
00070           ILMOIS=28+MAX (0,1-MOD (KDATEF(1),4))
00071         ELSE
00072           ILMOIS=30
00073         ENDIF
00074 C
00075         IF (KDATEF(3).GT.ILMOIS) THEN
00076           KREP=-82
00077           GOTO 1001
00078         ENDIF
00079 C
00080       ENDIF
00081 C
00082       KREP=0
00083 C**
00084 C     2.  -  SI DATE DEJA DEFINIE, COMPARAISON ANCIENNE/NOUVELLE.
00085 C-----------------------------------------------------------------------
00086 C
00087       IF (FA%LCREAF(KRANG)) THEN
00088         IDEBUT=1
00089       ELSE
00090 C
00091         DO 201 J=1,FA%JPLDAT
00092 C
00093         IF (FA%MADATE(J,KRANG).NE.KDATEF(J)) THEN
00094           LDMODA=.TRUE.
00095           IDEBUT=J
00096           GOTO 300
00097         ENDIF
00098 C
00099   201   CONTINUE
00100 C
00101 C         Si on arrive ici, il y a redefinition a l'identique.
00102 C
00103         GOTO 1001
00104       ENDIF
00105 C**
00106 C     3.  -  SI NECESSAIRE, MISE A JOUR DU TABLEAU "FA%MADATE".
00107 C-----------------------------------------------------------------------
00108 C
00109   300 CONTINUE
00110 C
00111       DO 301 J=IDEBUT,FA%JPLDAT
00112       FA%MADATE(J,KRANG)=KDATEF(J)
00113   301 CONTINUE
00114 C**
00115 C    10.  -  PHASE TERMINALE : MESSAGERIE EVENTUELLE,
00116 C            VIA LE SOUS-PROGRAMME "FAIPAR" .
00117 C-----------------------------------------------------------------------
00118 C
00119  1001 CONTINUE
00120       LLFATA=LLMOER (KREP,KRANG)
00121 C
00122       IF (FA%LFAMOP.OR.LLFATA) THEN
00123         INIMES=2
00124         CLNSPR='FANDAI'
00125         INUMER=FA%JPNIIL
00126         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='
00127 ',I4,     S       '', KDATEF(1:5)='',I5,2(''/'',I2),I3,'':'
00128 ',I2.2,     S       '', KDATEF(7:8)='',I6,''-'',I6,'', LDMODA= '',L1)')
00129      S     KREP,KRANG,(KDATEF(J),J=1,5),(KDATEF(J),J=7,8),LDMODA
00130         CALL FAIPAR_MT (FA, INUMER,INIMES,KREP,.FALSE.,CLMESS,
00131      S                  CLNSPR,CLACTI, .FALSE.)
00132       ENDIF
00133 C
00134       IF (LHOOK) CALL DR_HOOK('FANDAI_MT',1,ZHOOK_HANDLE)
00135       END
00136