module usegenplot implicit none integer, private :: color = 4 integer, private :: iochannel = -1 logical, private :: initialised = .FALSE. contains ! ------------------------------------------------------------------- subroutine init_genplot(filename) character(*), intent(in) :: filename integer :: errcode write(0, *) '--> init genplot "', filename, '"' open(newunit=iochannel, file=filename, iostat=errcode) write(0, *) 'iochannel', iochannel, 'errcode', errcode initialised = .TRUE. color = 4 ! XXX STOP 'ABEND' end subroutine subroutine end_genplot(message) character(*), intent(in) :: message integer :: errcode write(0, *) '--> end genplot "', message, '"' initialised = .FALSE. close(unit=iochannel, iostat=errcode) write(0, *) 'close errcode', errcode end subroutine ! ------------------------------------------------------------------- subroutine do_initialise_once(motif) character(*), intent(in) :: motif write(0, *) '--> do initialise once "', motif, '", flag is ', initialised call init_genplot('a.scratch') end subroutine ! ------------------------------------------------------------------- !- getter, setter, wtf ? subroutine gplt_setcol(col) integer, intent(in) :: col color = col end subroutine function gplt_getcol() integer gplt_getcol gplt_getcol = color end function ! ------------------------------------------------------------------- subroutine gplt_move(x, y) integer, intent(in) :: x, y if (.NOT. initialised) then call do_initialise_once('in gplt_move') endif write(iochannel, '(3I8)') x, y, 0 end subroutine ! ------------------------------------------------------------------- subroutine gplt_draw(x, y) integer, intent(in) :: x, y if (.NOT. initialised) then call do_initialise_once('in gplt_draw') endif write(iochannel, '(3I8)') x, y, color end subroutine ! ------------------------------------------------------------------- subroutine gplt_line(x1, y1, x2, y2) integer, intent(in) :: x1, y1, x2, y2 call gplt_move(x1, y1) call gplt_draw(x2, y2) end subroutine ! ------------------------------------------------------------------- !- ! sx, sy ! +-------------------+ ! | x2,y2 | ! | | ! | | ! | x1,y1 | ! +-------------------+ ! 0,0 subroutine gplt_rect(x1, y1, x2, y2) integer, intent(in) :: x1, y1, x2, y2 if (.NOT. initialised) then call do_initialise_once('in gplt_rect') endif call gplt_move(x1, y1) call gplt_draw(x2, y1) call gplt_draw(x2, y2) call gplt_draw(x1, y2) call gplt_draw(x1, y1) end subroutine ! ------------------------------------------------------------------- ! ------------------------------------------------------------------- end module