src/tool/Utilitaire/utdhcu.F

   1       subroutine utdhcu ( dateus, heurus,
   2      >                    datheu, numann,
   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 compacte en une forme US
  25 c ______________________________________________________________________
  26 c .        .     .        .                                            .
  27 c .  nom   . e/s . taille .           description                      .
  28 c .____________________________________________________________________.
  29 c . dateus .  s  .  ch9   . date au format americain 'dd-mon-yy'       .
  30 c . datheu . e   .   1    . nombre de secondes depuis le debut de l'an .
  31 c . numann . e   .   1    . numero de l'annee (complet)                .
  32 c . heurus .  s  .  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 c
  59       character*3 tabmon (12)
  60 c
  61 c====
  62 c 1. les constantes
  63 c====
  64 c
  65       tabmon (1) = 'Jan'
  66       tabmon (2) = 'Feb'
  67       tabmon (3) = 'Mar'
  68       tabmon (4) = 'Apr'
  69       tabmon (5) = 'May'
  70       tabmon (6) = 'Jun'
  71       tabmon (7) = 'Jul'
  72       tabmon (8) = 'Aug'
  73       tabmon (9) = 'Sep'
  74       tabmon (10) = 'Oct'
  75       tabmon (11) = 'Nov'
  76       tabmon (12) = 'Dec'
  77 c
  78 c====
  79 c 2. appel du programme generique
  80 c====
  81 c
  82       if ( codret.eq.0 ) then
  83 c
  84          call utdhcl ( nummoi, numjou, numheu, nummin, numsec,
  85      >                 numann, datheu,
  86      >                 codret )
  87 c
  88       endif
  89 c
  90 c====
  91 c 3. mise en forme
  92 c====
  93 c
  94 c 3.1. ==> initialisation
  95 c
  96       dateus = '01-Jan-00'
  97       heurus = '00:00:00'
  98 c
  99 c 3.2. ==> date
 100 c
 101       if ( numjou.le.9 .and. numjou.gt.1 ) then
 102          write ( dateus (2:2),'(i1)' ) numjou
 103       else if ( numjou.gt.9 .and. numjou.le.31 ) then
 104          write ( dateus (1:2),'(i2)' ) numjou
 105       endif
 106 c
 107       dateus (4:6) = tabmon(mod(nummoi-1,12)+1)
 108 c
 109       numann = mod ( numann , 100 )
 110       if ( numann.le.9 ) then
 111          write ( dateus (9:9),'(i1)' ) numann
 112       else
 113          write ( dateus (8:9),'(i2)' ) numann
 114       endif
 115 c
 116 c 3.3. ==> heure
 117 c
 118       if ( numheu.le.9 .and. numheu.gt.0 ) then
 119          write ( heurus (2:2),'(i1)' ) numheu
 120       else if ( numheu.gt.9 .and. numheu.le.23 ) then
 121          write ( heurus (1:2),'(i2)' ) numheu
 122       endif
 123 c
 124       if ( nummin.le.9 .and. nummin.gt.0 ) then
 125          write ( heurus (5:5),'(i1)' ) nummin
 126       else if ( nummin.gt.9 .and. nummin.le.59 ) then
 127          write ( heurus (4:5),'(i2)' ) nummin
 128       endif
 129 c
 130       if ( numsec.le.9 .and. numsec.gt.0 ) then
 131          write ( heurus (8:8),'(i1)' ) numsec
 132       else if ( numsec.gt.9 .and. numsec.le.59 ) then
 133          write ( heurus (7:8),'(i2)' ) numsec
 134       endif
 135 c
 136       end