SUBROUTINE dtcdspmth (ib,il,xoff,xspa,YOFF,yspa) c----------------------------------------------------------------------- c c DTCDSPMTH month printing subroutine (formerly MISCHY) c c part of Mitch Wyle's DTC program c c Inputs: c ib - begining day of the week c il - length of month in days c xoff - offset for x coordinate c xspa - number of spaces to skip between numbers c yoff - offset for y coordinate c yspa - number of lines to skip between lines c c Output: c display screen (see below) c c Modified 850301, CG - write full line at a time, rather that each date c Modified 850802, CG - Renamed from mischy c c----------------------------------------------------------------------- c c Declarations: integer ib ! beginning day of the week integer il ! length of month in days integer xoff ! x offset integer xspa ! number of spaces between numbers integer yoff ! y offset integer yspa ! number of lines to skip between lines include 'comdtc.inc/nolist' ! Need ITERM include 'escdtc.inc/nolist' integer ix ! x coordinate of where to put day integer iy ! y coordinate of where to put day integer ip ! the day of the week for date in hand integer ixo ! xoff + 1 integer nums(31) ! numbers as characters 1 / ' 1', ' 2', ' 3', ' 4', ' 5', ' 6', ' 7', ' 8', ' 9', 2 '10', '11', '12', '13', '14', '15', '16', '17', '18', '19', 3 '20', '21', '22', '23', '24', '25', '26', '27', '28', '29', 4 '30', '31'/ integer wknums (7) ! To contain copies of above, or blanks c Begin code do i = 1, 7 ! One week's worth wknums (i) = ' ' ! initialize end do ip = ib ix = xspa + 1 ! Used in format # 1 ixo = xoff + 1 iy = 4 + YOFF c Now write month out to screen, one week at a time: Do i = 1, il wknums(ip) = nums(i) ! Get day as character If ( ip .eq. 7 ) ! is it Saturday again? 1 then call dtcat(ixo,iy) ! Position cursor for line write (iterm,1) wknums ! Write filled array ip = 1 ! reset day to Sunday. iy = iy + 1 + yspa ! move down one line else ip = ip + 1 ! increment day number End If end do if (ip .ne. 1) ! Partial buffer remains 1 then call dtcat(ixo,iy) ! Position cursor write (iterm,1) (wknums(i), i = 1, ip - 1) ! Write rest of array end if 1 format('+',6(a2,x),a2) end