[CONTACT]

[ABOUT]

[POLICY]

CONTAINS ROUTINES FOR THE MICRO PRO

Found at: ftp.icm.edu.pl:70/packages/netlib/microscope/screen.f

C  FILE:     SCREEN
C
C  PURPOSE:  CONTAINS ROUTINES FOR THE MICRO PROGRAM WHICH USE SCREEN
C             EDITING.
C
C  THE ROUTINE IN THIS FILE MUST BE SUPPORTED BY INSTALLATION PROVIDED
C  SCREEN EDITING ROUTINES.  SEE THE MICROSCOPE MANUAL FOR DETAILS.
C
C  WRITTEN BY: BILL HARRIS
C  DATE:       7/27/83
C
      SUBROUTINE SGRAPH(GRAPHD,NCALLS,LGO)
C
C***********************************************************************
C
C  ROUTINE:  SGRAPH
C  PURPOSE:  TO PLOT THE FUNCTIONS ON A DEVICE WHICH ALLOWS SCREEN
C             EDITING.  THE ROUTINE ONLY UPDATES THE PORTION OF THE
C             SCREEN WHICH NEEDS ALTERING.
C
      INTEGER  GRAPHD,    NCALLS,         CHARS(135)
      INTEGER  OUTPTD,     LINES,    WIDTH,      ILP,   IDSPLA,  IPRMPT
      LOGICAL   LSCRN,     LGO
      COMMON  /SCREEN/    OUTPTD,    LINES,    WIDTH,      ILP,  IDSPLA,
     X         IPRMPT,     LSCRN
      REAL       SCALE
      INTEGER    IPLOT,   ISCRN1,   ISCRN2
      COMMON /PLTCOM/   SCALE(7),     IPLOT(135,7),    ISCRN1(135,57),
     X            ISCRN2(135,57)
C
C  IF LSCRN = .FALSE. THEN THE ENTIRE SCREEN MUST BE REGENERATED
C
      IF ( LSCRN ) GO TO 300
      K = 1
      CALL BLSCRN(GRAPHD)
           DO 200 I = 1,ILP
           II = I
                DO 100 J = 1,WIDTH
                CHARS(J) = ISCRN2(J,I)
                ISCRN1(J,I) = CHARS(J)
  100           CONTINUE
           CALL PLCHRS(GRAPHD,K,II,WIDTH,CHARS)
  200      CONTINUE
      GO TO 1200
C
C  USING SCREEN EDITING, UPDATE ONLY THE PARTS THAT NEED UPDATING
C
  300      DO 1100 I = 1,ILP
           II   = I
           N    = 0
           JBEG = 1
           JEND = 1
  400      IF ( JBEG.GT.WIDTH ) GO TO 1100
           JJBEG = JBEG
                DO 500 J = JJBEG,WIDTH
                IF ( ISCRN1(J,I).EQ.ISCRN2(J,I) ) GO TO 500
                JBEG = J
                GO TO 600
  500           CONTINUE
           GO TO 1100
  600      IF ( JBEG.LT.WIDTH ) GO TO 700
           JBEG = WIDTH
           JEND = WIDTH
           GO TO 900
  700      JP   = JBEG+1
                DO 800 J = JP,WIDTH
                IF ( ISCRN1(J,I).NE.ISCRN2(J,I) ) GO TO 800
                JEND = J-1
                GO TO 900
  800           CONTINUE
           JEND = WIDTH
  900      N    = JEND-JBEG+1
                DO 1000 J = 1,N
                JJ           = JBEG+J-1
                CHARS(J)     = ISCRN2(JJ,I)
                ISCRN1(JJ,I) = ISCRN2(JJ,I)
 1000           CONTINUE
           CALL PLCHRS(GRAPHD,JBEG,II,N,CHARS)
           JBEG = JEND+2
           GO TO 400
 1100      CONTINUE
C
C  DISPLAY THE NUMERICAL DATA CORRESPONDING TO THE PLOT
C
 1200 MODE = 2
      CALL SDDATA(GRAPHD,MODE,NCALLS,LGO)
      LSCRN= .TRUE.
      RETURN
      END

.


AD:

NEW PAGES:

[ODDNUGGET]

[GOPHER]