!Utilities.F95
!2021.04.06.0535cdt JMS- Traveler2/Athlon64/WinXPPro/APF9.0/Ogl1.2.1

!Table of Contents:
!  Subroutine DateAndTime22(DaTime)
!  Subroutine ElapsedTime(DaTime1,DaTime2,TElapsed,Minutes,iP)
!  Subroutine TimeStamp(cL,Chrono,iW)
!  Subroutine WSF(cL,iW)
!  Subroutine MyLenTrim(cL,nCu,iP)
!  Subroutine Beamer(N,Nmax,iP)
!---------------------------------------------------------------------------7-9
Subroutine DateAndTime22(DaTime)
!2021.03.21.1015cdt JMS- Present date & time string -> DaTimeLabel*22
!Elapsed is updated first,
!       so using the same argument twice results in returning the DaTime value.
!--Arguments
 implicit none
  character::DaTime*22
 !--Internals
  character::cDate*8,cTime*10,cZone*5
  integer*4::iYMDZHMSM(8)
  !--EndDefs-----------------------------------------------
   call DATE_AND_TIME(cDate,cTime,cZone,iYMDZHMSM)
   write(DaTime, &
   "( i4,'.',i2.2,'.',i2.2,'.',i2.2,i2.2,'.',i2.2'.',i3.3)") &
                      iYMDZHMSM(1:3),iYMDZHMSM(5:8)
                                                                         return
End Subroutine DateAndTime22
!---------------------------------------------------------------------------7 9
Subroutine ElapsedTime(DaTime1,DaTime2,TElapsed,Minutes,iP)
!2021.03.22.1015cdt JMS- Present date & time string -> DaTimeLabel*22
!Elapsed is updated first,
!       so using the same argument twice results in returning the DaTime value.
!--Arguments
 implicit none
  character::DaTime1*22
  character::DaTime2*22
  character::TElapsed*22
  real*16  ::Minutes
  integer*4::iP           !Write enable>5: write(iP,...)
 !--Internals
  integer*4::iYMDZHMSM(8,2)
  integer*4::i,iTimer(3)
  character::cL*80
  !--EndDefs-----------------------------------------------
   iYMDZHMSM = 0
   do i=1,2       !2021.03.21.0945.52.765
     if(i==1) &
     read(Datime1,"(i4,1x,i2,1x,i2,1x,2i2,1x,i2,1x,i3)") &
                   iYMDZHMSM(1:3,i),iYMDZHMSM(5:8,i)
     if(i==2) &
     read(Datime2,"(i4,1x,i2,1x,i2,1x,2i2,1x,i2,1x,i3)") &
                   iYMDZHMSM(1:3,i),iYMDZHMSM(5:8,i)
     iTimer(i) =  ( ( ( iYMDZHMSM(3,i)     *  24 & !   hours/day
                       +iYMDZHMSM(5,i) )   *  60 & ! minutes/hour
                     +  iYMDZHMSM(6,i)  )  *  60 & ! seconds/min 
                   +    iYMDZHMSM(7,i)   ) *1000 & !mseconds/sec
                 +      iYMDZHMSM(8,i)                           ;enddo!i
   iTimer(3)=iTimer(2)-iTimer(1); if(iTimer(3)<0) itimer(3)=0
   iYMDZHMSM(1:8,2) = 0
   iYMDZHMSM( 8 ,2) = mod(iTimer(3),   1000)          !milliseconds
   iYMDZHMSM( 7 ,2) = mod(iTimer(3),  60000)/    1000 !seconds
   iYMDZHMSM( 6 ,2) = mod(iTimer(3),3600000)/   60000 !minutes
   iYMDZHMSM( 5 ,2) = mod(iTimer(3),3600000)/ 3600000 !hours
   iYMDZHMSM( 3 ,2) =     iTimer(3)         /86400000 !days
   write(TElapsed,"( 8x,i2.2,'.',i2.2,i2.2,'.',i2.2'.',i3.3)") &
                      iYMDZHMSM(3,2),iYMDZHMSM(5:8,2)
   minutes = iTimer(3)/60000._16
!  if(1>0) return !//Diagnostic
   if(iP<6)                                                              return
   write(cL,"(38x,'Elapsed time:')")   ; call TimeStamp(cL,TElapsed,iP)
!                      2021.03.21.0945.52.765
   write(cL,"(57x,'year ^m ^d ^h^m ^s ^ms')");      call WSF(cL,iP)
                                                                         return
End Subroutine ElapsedTime
!---------------------------------------------------------------------------7 9
Subroutine TimeStamp(cL,Chrono,iW)                         !2021.03.25.0815
!2021.03.25.0815cdt JMS- Turning leading zeros to spaces.
!2021.03.21.0925cdt JMS- Expanded timestamp to 22 characters.
!                        Hence 52 characters are available for your use.
!2013.11.04.1340cst JMS- Writes a labeled timestamp to the screen (& #iW if>12)
!                         79 characters wide with a trailing char(0).
!                      - Useful in timing alogrithms & also in chronologically
!                          sorting output hardcopies days after-the-fact.
!                      - Traveler2/Athlon64/WinXPPro/APF9.0/Ogl1.2.1
 implicit none                                                       !arguments
  character*(*)::cL
  character    ::Chrono*22
  integer*4    ::iW
  !---                                                               !internals
  character    ::ChronoL*22
  character    :: c80*80
  integer*4    :: i,n,NumCharUsed
  !-----
   if(iW.lt.5) return
!  --Replace Chrono leading zeros with spaces:
   ChronoL = Chrono
   do n=1,22; i=iChar(ChronoL(n:n))
          if((i>=49).and.(i<=57)) exit
          if( i==48             ) ChronoL(n:n) = char(32)              ;enddo!n

!  --Leave label room for Chrono, right justified: e.g.  2021.03.25.0723.48.890
                  c80 = char(32)
                  c80( 1:             5) = "!--- "
   call MyLenTrim(cL,NumCharUsed,0)
                         !NumCharUsed=len_trim(cL)
                      if(NumCharUsed.gt.52)         NumCharUsed=52
                  c80( 6:NumCharUsed+ 5) = cL(1:NumCharUsed)
                  c80(58:            79) = ChronoL
                  c80(80:            80) = char(0)
                                                      call WSF(c80,iW)
   return
End Subroutine TimeStamp
!---------------------------------------------------------------------------7 9
Subroutine WSF(cL,iW)                                 !2013.11.04.0545
!2013.11.04.0545cst JMS- Writes nowhere, to screen, or to the screen & a file.
!                      - Label length is arbitrary.
!                      - Traveler2/Athlon64/WinXPPro/APF9.0/Ogl1.2.1
 implicit none                                                       !arguments
  character*(*)::cL
 !character    ::cL*80
  integer*4 ::iW
  !---                                                               !internals
  integer*4 :: i,nCU
  !-----
   call MyLenTrim(cL,nCU,0)
   select case(iW)
    case(  : 5); return
    case(6 :12); do i=1,nCU ;write( 6,"(a1,\))") cL(i:i) ;enddo!i
                             write( 6,"(''))")
    case(13:  ); do i=1,nCU ;write( 6,"(a1,\))") cL(i:i) ;enddo!i
                             write( 6,"(''))")
                 do i=1,nCU ;write(iW,"(a1,\))") cL(i:i) ;enddo!i
                             write(iW,"(''))")
   end select !iW
   return
End Subroutine WSF
!---------------------------------------------------------------------------7 9
Subroutine MyLenTrim(cL,nCu,iP)                           !2013.11.07.0510
!2013.11.07.0510cst JMS- My version of len_trim.
!                          Trailing spaces, C/R's, & LF's are char(0)'d.
!                          Interior char(0)'s are converted to spaces.
!                      - Traveler2/Athlon64/WinXPPro/APF9.0
 implicit none
  character*(*)::cL                                              !arguments
  integer*4    ::nCU
  integer*4    ::iP

  integer*4   ::nSize                                                !internals
  integer*4   ::i       
  character   ::A0*1,A32*1
  !----------
   nSize=len(cL)
   if(iP.gt.5) then; write(iP,*) 'cL=',cL
                     write(iP,*) 'cL=',(iChar(cL(i:i)),i=1,80)
                     write(iP,*) 'nSize =',nSize
   endif !iP>5

   A0 =char(0) ;A32=char(32) ;nCU=0
   do i=nSize,1,-1
     select case(ichar(cL(i:i)))
      case( 0) ;goto 10
      case(10) ;goto 10
      case(13) ;goto 10
      case(32) ;goto 10
      case default; if(nCU.gt.0) cycle ;nCU=i ;cycle
     end select !ichar(cL(i:i))
10   if(nCU.eq.0) cL(i:i)=A0
     if(nCU.gt.0) cL(i:i)=A32
   enddo!i

   if(iP.gt.5) then
     write(iP,"('nCU=',i6)") nCU 
     do i=1,nSize ;write(iP,"(i4,\)") ichar(cL(i:i));enddo
                   write(iP,"(' ')")
   endif!iP>5
   return
End Subroutine MyLenTrim
!---------------------------------------------------------------------------7 9
Subroutine Beamer(N,Nmax,iP)                                    !2009.01.22.0800
!2009.01.22.0800cst JMS- Derived from Beamer (above)
!2007.10.10.0830cdt JMS- Nstat=(N*78)/Nmax
!2006.08.02.1700cdt JMS- HPPavilion/WinXPPro/APF9.0/Ogl1.2.1
!1990.11.19.1240cst JMS- 386/DOS/FORTRAN
 implicit none
 !--Arguments
  integer*4 ::N,nMax
  integer*4 ::iP           !Write enable>5: write(iP,...)
 !--Internals
  integer*4 :: kStat,nStat
  !--EndDefs-----------------------------------------------
                                                                if(iP<6) return
   if(Nmax .lt.    1) stop 'BeamerL: Nmax < 1'
   if(N    .le.    1) then; Kstat=0   ;write(unit=iP,"(1x \)")           ;endif
                            Nstat=(N*78)/Nmax
10 if(Nstat.gt.Kstat) then; Kstat=Kstat+1 
                                      write(unit=iP,"('*'\)") ;goto 10   ;endif
   if(N    .ge.Nmax )                 write(unit=iP,"('*' )")
   return
End Subroutine Beamer
!---------------------------------------------------------------------------7 9

