! Modifications A.B. 01/11/09
!     ===================================================================
       SubRoutine Debut (ProgNam,Mouch_lis)
!     ===================================================================

      character ProgNam*(*),  &                 ! Nom du programme
               & cDate*8,cTime*10              ! Date et heure
      character Mouch_lis*(*)  
	  character annee*4, mois*2, jour*2
	  character heure*2, minute*2, seconde*6          

      open (Unit = 10,File = Mouch_lis  ,Status = 'unknown',Access='append')
      
      call Date_and_time(cDate,cTime)
	  annee=cdate(1:4)
	  mois=cdate(5:6)
	  jour=cdate(7:8)
	  heure=ctime(1:2)
	  minute=ctime(3:4)
	  seconde=ctime(5:10)

      call WC (' ')
      call WC  &
        & (Trim(ProgNam)//' on '//jour//'th '//mois//' '//annee//' at '//heure//'h '//minute//'mn '//seconde//'s')

      RETURN
      end
            
!     ===================================================================
       SubRoutine LaFin (ProgNam)
!     ===================================================================

      character ProgNam*(*), &              !Nom du programme
              & cDate*8,cTime*10            !Date et heure
	  character annee*4, mois*2, jour*2
	  character heure*2, minute*2, seconde*6          

      call Date_and_time(cDate,cTime)
	  annee=cdate(1:4)
	  mois=cdate(5:6)
	  jour=cdate(7:8)
	  heure=ctime(1:2)
	  minute=ctime(3:4)
	  seconde=ctime(5:10)
      call WC &
        & (Trim(ProgNam)//' End  at '//heure//'h '//minute//'mn '//seconde//'s')
      close (10)

!     ===================================================================
      RETURN
      end
!     ===================================================================
       SubRoutine WC (Texte)
!     ===================================================================
!     Le sous-programme WC ecrit une chaine de caractere sur l'environnement.
!     Slezak E. - Juillet 1990
!     ===================================================================
      character*(*) Texte                   ! Ligne a ecrire

      write (6,*)  Trim(Texte)
      write (10,*) Trim(Texte)
!     ===================================================================
      RETURN
      end
      
!     ===================================================================
       SubRoutine WR (Prompt,rArray,NVal)
!     ===================================================================
!     Le sous-programme WR ecrit un tableau de reels*4 sur l'environnement.
!     Slezak E. - Mars 1992

!     Prompt : Message.
!     rArray : Tableau des valeurs.
!     NVal   : Nombre de valeurs du tableau rArray.
!     ===================================================================

      character*(*) Prompt
           
      real*4 rArray(Nval)
           
      If(Nval<=2) Then
          WRITE  (6,*) Prompt,': ',rArray
          WRITE (10,*) Prompt,': ',rArray
      Else
          WRITE  (6,*) Prompt,': '
          WRITE (10,*) Prompt,': '
          WRITE  (6,*) rArray
          WRITE (10,*) rArray
      ENDif

!     ===================================================================
      RETURN
      end
!     ===================================================================
       SubRoutine WI (Prompt,iArray,NVal)
!     ===================================================================
!     Le sous-programme WI ecrit un tableau d'entiers en Integer*4 sur
!     l'environnement.
!     Slezak E.       -       Mars 1992

!     Prompt : Message.
!     iArray : Tableau des valeurs.
!     NVal   : Nombre de valeurs du tableau iArray.
!     ===================================================================

      character*(*)Prompt
          
      integer*4 iArray(Nval)
          
      If(Nval<=2) Then
          WRITE  (6,*) Prompt,': ',iArray
          WRITE (10,*) Prompt,': ',iArray
      Else
          WRITE  (6,*) Prompt,': '
          WRITE (10,*) Prompt,': '
          WRITE  (6,*) iArray
          WRITE (10,*) iArray
      ENDif

!     ===================================================================
      RETURN
      end

!=======================================================================  
  SubRoutine RC (Prompt,Status,NVal,Texte,NCar)
! =====================================================================
!  Le sous-programme RC realise la saisie d'une chaine de caracteres.
!  Slezak E,      -      Juillet 1990

!  Prompt : Message d'interrogation.
!  Status : Peut-on avoir une valeur par defaut ([DE],NO) ?
!  NVal   : Parametre ignore par ce sous-programme.
!  Texte  : Texte fourni (les blancs en debut et en fin sont otes).
!  NCar   : Nombre de caracteres de la chaine Texte ([0]).
! ====================================================================

      character*(*)  Prompt,Texte
      character Line*(80)
      character Status*2

      logical*1 Default
           
      NCarM = 80
!     -------------------------------------------------------------------
110   format (Q,a)
200   format ('Vous devez repondre par un texte non nul.')
210   format ('Votre texte depasse 80 caracteres...')
!      -------------------------------------------------------------------

      Default = .True.
      if ( Status.eq.'NO' .or. Status.eq.'no' ) then
          Default = .False.
      endif

      iPromptL = len( Prompt )
!     ===================================================================
1000      CONTINUE
      WRITE (6,"(1x,a,' > ',$)") Trim(Prompt)
      READ  (5,110) NCar,Line

      if ( NCar.eq.0 ) then
          if ( Default ) then
              Texte = Trim(Line)
              RETURN
          else
              WRITE (6,200)
              GOTO 1000
          endif
      endif
      if ( NCar.gt.NCarM ) then
          WRITE (6,210)
          GOTO 1000
      endif

      DO WHILE ( Line(NCar:NCar).eq.' ' .and. NCar.ge.1 )
          NCar = NCar - 1
      ENDDO
      ILast = NCar

      if ( ILast.eq.0 ) then            ! Chaine nulle
          if ( Default ) then
              iFirst = 1
              iLast  = 1
          else
              WRITE (6,200)
              GOTO 1000
          endif
      else
          ICar = 1
          DO WHILE ( Line(ICar:ICar).eq.' ' .and. ICar.lt.ILast )
              ICar = ICar + 1
          ENDDO
          iFirst = ICar                 ! 1er caractere du texte
      endif
      NCar  = ILast - IFirst + 1
      Texte = Line(IFirst:ILast)

!     ===================================================================
      RETURN
      end