src/tool/Utilitaire/utdhlg.F

   1       subroutine utdhlg ( ladate, langue )
   2 c
   3 c ______________________________________________________________________
   4 c
   5 c                             H O M A R D
   6 c
   7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   8 c
   9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  10 c aupres des huissiers de justice Simart et Lavoir a Clamart
  11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  12 c aupres des huissiers de justice
  13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  14 c
  15 c    HOMARD est une marque deposee d'Electricite de France
  16 c
  17 c Copyright EDF 1996
  18 c Copyright EDF 1998
  19 c Copyright EDF 2002
  20 c Copyright EDF 2020
  21 c ______________________________________________________________________
  22 c
  23 c  donne la date et l'heure sous forme longue
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . ladate .  s  .   1    . date et heure sous forme longue            .
  29 c . langue .  s  .   1    . langue retenue                             .
  30 c .        .     .        . 1 : francais, 2 : anglais                  .
  31 c ______________________________________________________________________
  32 c
  33 c====
  34 c 0. declarations et dimensionnement
  35 c====
  36 c
  37 c 0.1. ==> generalites
  38 c
  39       implicit none
  40       save
  41 c
  42 #include "nblang.h"
  43 c
  44 c 0.2. ==> communs
  45 c
  46 c 0.3. ==> arguments
  47 c
  48       integer langue
  49 c
  50       character*48 ladate
  51 c
  52 c 0.4. ==> variables locales
  53 c
  54       integer numann, nummoi, numjou, numjos
  55       integer numheu, nummin, numsec
  56 c
  57       integer ideb, ifin
  58       integer langlo
  59 c
  60 c 0.5. ==> initialisations
  61 c
  62 #include "utjomo.h"
  63 c
  64 c_______________________________________________________________________c
  65 c====
  66 c 1.  acquisition de la date
  67 c====
  68 c
  69       call dmjohe ( numann, nummoi, numjou, numjos,
  70      >              numheu, nummin, numsec )
  71 c
  72 c====
  73 c 2. mise en forme
  74 c====
  75 c
  76 c 2.1. ==> initialisation
  77 c
  78 c               123456789012345678901234567890123456789012345678
  79       ladate = '                                                '
  80 c
  81       if ( langue.ge.1 .and. langue.le.nblang ) then
  82         langlo = langue
  83       else
  84         langlo = 1
  85       endif
  86 c
  87 c 2.2. ==> nom et numero du jour
  88 c
  89       if ( numjos.le.0 ) then
  90         ifin = -1
  91       else
  92         ifin = lgnomj(langlo,numjos)
  93         ladate (1:ifin) = nomjou(langlo,numjos)
  94       endif
  95 c
  96       ideb = ifin+2
  97       if ( numjou.le.9 ) then
  98         ifin = ideb
  99         write ( ladate (ideb:ifin),'(i1)' ) numjou
 100       else
 101         ifin = ideb + 1
 102         write ( ladate (ideb:ifin),'(i2)' ) numjou
 103       endif
 104 c
 105 c 2.3. ==> nom du mois
 106 c
 107       if (nummoi.gt.0) then
 108         ideb = ifin + 2
 109         ifin = ideb + lgnomm(langlo,mod(nummoi-1,12)+1) - 1
 110         ladate (ideb:ifin) = nommoi(langlo,mod(nummoi-1,12)+1)
 111       endif
 112 c
 113 c 2.4. ==> numero de l'annee
 114 c
 115       ideb = ifin + 2
 116       ifin = ideb + 3
 117       write ( ladate (ideb:ifin),'(i4)' ) numann
 118 c
 119 c 2.5. ==> heure
 120 c
 121       ideb = ifin + 2
 122       if ( langlo.eq.1 ) then
 123         ifin = ideb + 1
 124         ladate (ideb:ifin) = 'a '
 125       else
 126         ifin = ideb + 2
 127         ladate (ideb:ifin) = 'at '
 128       endif
 129 c
 130       ideb = ifin + 1
 131       if ( numheu.le.9 ) then
 132         ifin = ideb
 133         write ( ladate (ideb:ifin),'(i1)' ) numheu
 134       else
 135         ifin = ideb + 1
 136         write ( ladate (ideb:ifin),'(i2)' ) numheu
 137       endif
 138 c
 139       ideb = ifin + 1
 140       ifin = ideb + 2
 141       ladate (ideb:ifin) = ' h '
 142 c
 143       ideb = ifin + 1
 144       if ( nummin.le.9 ) then
 145         ifin = ideb
 146         write ( ladate (ideb:ifin),'(i1)' ) nummin
 147       else
 148         ifin = ideb + 1
 149         write ( ladate (ideb:ifin),'(i2)' ) nummin
 150       endif
 151 c
 152       ideb = ifin + 1
 153       ifin = ideb + 3
 154       ladate (ideb:ifin) = ' mn '
 155 c
 156       ideb = ifin + 1
 157       if ( numsec.le.9 ) then
 158         ifin = ideb
 159         write ( ladate (ideb:ifin),'(i1)' ) numsec
 160       else
 161         ifin = ideb + 1
 162         write ( ladate (ideb:ifin),'(i2)' ) numsec
 163       endif
 164 c
 165       ideb = ifin + 1
 166       ifin = ideb + 1
 167       ladate (ideb:ifin) = ' s'
 168 c
 169       end