src/tool/Utilitaire/utdhfc.F

   1       subroutine utdhfc ( datheu, numann,
   2      >                    datefr, heurfr,
   3      >                    codret )
   4 c
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c     convertit la date et l'heure
  26 c     de la forme Francaise en une forme compacte
  27 c ______________________________________________________________________
  28 c .        .     .        .                                            .
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . datheu .  s  .   1    . nombre de secondeS depuis le debut de l'an .
  32 c . numann .  s  .   1    . numero de l'annee (complet)                .
  33 c . datefr . e   .  ch8   . date au format francais 'jj/mm/aa'         .
  34 c . heurfr . e   .  ch8   . heure au format francais 'hh:mm:ss'        .
  35 c . codret .  s  .   1    . code de retour                             .
  36 c ______________________________________________________________________
  37 c
  38 c====
  39 c 0. declarations et dimensionnement
  40 c====
  41 c
  42 c 0.1. ==> generalites
  43 c
  44       implicit none
  45       save
  46 c
  47 c 0.2. ==> communs
  48 c
  49 c 0.3. ==> arguments
  50 c
  51       integer datheu, numann
  52       integer codret
  53 c
  54       character*8 datefr
  55       character*8 heurfr
  56 c
  57 c 0.4. ==> variables locales
  58 c
  59       integer nummoi, numjou, numheu, nummin, numsec
  60 c
  61 c====
  62 c 1. determination des differents numeros
  63 c    remarque : on suppose que l'on ne prendra pas des objets
  64 c               anterieurs a 1970 et qu'apres 2070, on aura recode ...
  65 c====
  66 c
  67       if ( index('123',datefr(1:1)).gt.0 .and.
  68      >     index('0123456789',datefr(2:2)).gt.0       ) then
  69 c
  70         read ( datefr (1:2),'(i2)' ) numjou
  71 c
  72         if ( numjou.gt.31 ) then
  73           numjou = 1
  74           codret = 1
  75         endif
  76 c
  77       else if ( index(' 0',datefr(1:1)).gt.0 .and.
  78      >          index('123456789',datefr(2:2)).gt.0       ) then
  79 c
  80         read ( datefr (2:2),'(i1)' ) numjou
  81 c
  82       else if ( datefr(2:2).eq.' ' .and.
  83      >          index('123456789',datefr(1:1)).gt.0       ) then
  84 c
  85         read ( datefr (1:1),'(i1)' ) numjou
  86 c
  87       else
  88         numjou = 1
  89         codret = 1
  90       endif
  91 c
  92       if ( index(' 01',datefr(4:4)).gt.0 .and.
  93      >     index('0123456789',datefr(5:5)).gt.0       ) then
  94 c
  95         read ( datefr (4:5),'(i2)' ) nummoi
  96 c
  97         if ( nummoi.le.0 .or. nummoi.gt.12 ) then
  98           nummoi = 1
  99           codret = 1
 100         endif
 101 c
 102       else if ( datefr(5:5).eq.' ' .and.
 103      >     index('123456789',datefr(4:4)).gt.0       ) then
 104 c
 105         read ( datefr (4:4),'(i1)' ) nummoi
 106 c
 107       else
 108         nummoi = 1
 109         codret = 1
 110       endif
 111 c
 112       if ( index('0123456789',datefr(7:7)).gt.0 .and.
 113      >     index('0123456789',datefr(8:8)).gt.0       ) then
 114 c
 115         read ( datefr (7:8),'(i2)' ) numann
 116         if ( numann.lt.70 ) then
 117            numann = 2000 + numann
 118         else
 119            numann = 1900 + numann
 120         endif
 121 c
 122       else
 123         numann = 1970
 124         codret = 1
 125       endif
 126 c
 127 c apres la date, on s'occupe maintenant de l'heure :
 128 c
 129       if ( index(' 012',heurfr(1:1)).gt.0        .and.
 130      >     index('0123456789',heurfr(2:2)).gt.0       ) then
 131 c
 132         read ( heurfr (1:2),'(i2)' ) numheu
 133 c
 134         if (numheu.gt.23) then
 135           numheu = 0
 136           codret = 1
 137         endif
 138 c
 139       else if ( heurfr(2:2).eq.' '        .and.
 140      >     index('0123456789',heurfr(1:1)).gt.0       ) then
 141 c
 142         read ( heurfr (1:1),'(i1)' ) numheu
 143 c
 144       else
 145 c
 146         numheu = 0
 147         codret = 1
 148 c
 149       endif
 150 c
 151       if ( index(' 012345',heurfr(4:4)).gt.0 .and.
 152      >     index('0123456789',heurfr(5:5)).gt.0       ) then
 153 c
 154         read ( heurfr (4:5),'(i2)' ) nummin
 155 c
 156         if (nummin.gt.59) then
 157           nummin = 0
 158           codret = 1
 159         endif
 160 c
 161       else if ( heurfr(5:5).eq.' ' .and.
 162      >     index('0123456789',heurfr(4:4)).gt.0       ) then
 163 c
 164         read ( heurfr (4:4),'(i1)' ) nummin
 165 c
 166       else
 167 c
 168         nummin = 0
 169         codret = 1
 170 c
 171       endif
 172 c
 173       if ( index(' 012345',heurfr(7:7)).gt.0 .and.
 174      >     index('0123456789',heurfr(8:8)).gt.0       ) then
 175 c
 176         read ( heurfr (7:8),'(i2)' ) numsec
 177 c
 178         if (numsec.gt.59) then
 179           numsec = 0
 180           codret = 1
 181         endif
 182 c
 183       else if ( heurfr(8:8).eq.' ' .and.
 184      >     index('0123456789',heurfr(7:7)).gt.0       ) then
 185 c
 186         read ( heurfr (7:7),'(i1)' ) numsec
 187 c
 188         if (numsec.gt.59) then
 189           numsec = 0
 190           codret = 1
 191         endif
 192 c
 193       else
 194 c
 195         numsec = 0
 196         codret = 1
 197 c
 198       endif
 199 c
 200 c====
 201 c 2. appel du programme generique
 202 c====
 203 c
 204       if ( codret.eq.0 ) then
 205 c
 206          call utdhlc ( datheu, numann,
 207      >                 nummoi, numjou, numheu, nummin, numsec,
 208      >                 codret )
 209 c
 210       else
 211 c
 212         datheu = 0
 213 c
 214       endif
 215 c
 216       end