37 integer(I4B),
intent(in) :: iout
38 integer(I4B),
intent(in) :: iprtim
40 character(len=LINELENGTH) :: line
41 integer(I4B) :: IEDT(8), IDPM(12)
44 integer(I4B) :: ndays, leap, ibd, ied, mb, me, nm, mc, m
45 integer(I4B) :: nhours, nmins, nsecs, msecs, nrsecs
46 real(DP) :: elsec, rsecs
47 data idpm/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
50 character(len=*),
parameter :: fmtdt = &
51 "(1x,'Run end date and time (yyyy/mm/dd hh:mm:ss): ', &
52 &I4,'/',I2.2,'/',I2.2,1x,I2,':',I2.2,':',I2.2)"
53 character(len=*),
parameter :: fmttma = &
54 "(1x,'Elapsed run time: ',I3,' Days, ',I2,' Hours, ',I2, &
55 &' Minutes, ', I2, ' Seconds')"
56 character(len=*),
parameter :: fmttmb = &
57 &
"(1x,'Elapsed run time: ',I2,' Hours, ',I2,' Minutes, ',I2,' Seconds')"
58 character(len=*),
parameter :: fmttmc = &
59 &
"(1x,'Elapsed run time: ',I2,' Minutes, ',I2,'.',I3.3,' Seconds')"
60 character(len=*),
parameter :: fmttmd = &
61 &
"(1x,'Elapsed run time: ',I2,'.',I3.3,' Seconds')"
64 call date_and_time(values=iedt)
67 write (line, fmtdt) (iedt(i), i=1, 3), (iedt(i), i=5, 7)
68 call write_message(line, skipbefore=1)
72 call write_message(line, iunit=iout, skipbefore=1)
78 if (mod(iedt(1), 4) == 0) leap = 1
83 if (ibdt(2) /= iedt(2))
then
88 if (mb > me) nm = nm + 12
94 ndays = ndays + idpm(mc) - ibd
95 if (mc == 2) ndays = ndays + leap
96 elseif (mc == me)
then
99 ndays = ndays + idpm(mc)
100 if (mc == 2) ndays = ndays + leap
103 elseif (ibd < ied)
then
110 elsec = elsec + (iedt(5) - ibdt(5)) * 3600.0
111 elsec = elsec + (iedt(6) - ibdt(6)) * 60.0
112 elsec = elsec + (iedt(7) - ibdt(7))
113 elsec = elsec + (iedt(8) - ibdt(8)) * 0.001
116 ndays = int(elsec / nspd)
117 rsecs = mod(elsec, dsecperdy)
118 nhours = int(rsecs / 3600.0)
119 rsecs = mod(rsecs, dsecperhr)
120 nmins = int(rsecs / 60.0)
121 rsecs = mod(rsecs, dsixty)
123 rsecs = mod(rsecs, done)
124 msecs = nint(rsecs * 1000.0)
126 if (rsecs > 0.5) nrsecs = nrsecs + 1
130 write (line, fmttma) ndays, nhours, nmins, nrsecs
131 elseif (nhours > 0)
then
132 write (line, fmttmb) nhours, nmins, nrsecs
133 elseif (nmins > 0)
then
134 write (line, fmttmc) nmins, nsecs, msecs
136 write (line, fmttmd) nsecs, msecs
138 call write_message(line, skipafter=1)
143 WRITE (iout, fmttma) ndays, nhours, nmins, nrsecs
144 ELSEIF (nhours > 0)
THEN
145 WRITE (iout, fmttmb) nhours, nmins, nrsecs
146 ELSEIF (nmins > 0)
THEN
147 WRITE (iout, fmttmc) nmins, nsecs, msecs
149 WRITE (iout, fmttmd) nsecs, msecs