src/tool/Utilitaire/utdhuc.F

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