[CONTACT]

[ABOUT]

[POLICY]

support of lower case letters for

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

C FILE: LC   This file contains all the subroutines that require the
C support of lower case letters for their proper functioning, including
C the master routines MCRSCP.  If lower case letters are not available,
C then the file UC shoul be used instead.
C
      SUBROUTINE MCRSCP(F,INPT,OUTPT,GRAPHC,HLP,RCRD,RESTRT,
     X                  ILINES,IWIDTH,IPLT,IDATA,IPROMP)
C-----------------------------------------------------------------------
C  DRIVER PROGRAM:  MCRSCP.FOR
C
C  PURPOSE:       TO INVESTIGATE CONTINUITY PROPERTIES OF
C                  BIVARIATE AND TRIVARIATE INTERPOLATION
C                   FUNCTIONS BY GRAPHICALLY DISPLAYING
C                    DIRECTIONAL DERIVATIVES (UP TO SIXTH
C                     ORDER).
C
C  WRITTEN BY:    BILL HARRIS AND PETER ALFELD
C
C  DATE BEGUN:    6/17/83
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C  ARGUMENTS:
C
C     INPT  =  INPUT DEVICE NUMBER   (USUALLY THE TERMINAL)
C     OUTPT  =  OUTPUT DEVICE NUMBER  (USUALLY THE TERMINAL)
C     GRAPHC  =  GRAPHIC DEVICE NUMBER (TERMINAL OR GRAPHICS DISPLAY)
C     HLP   =  HELP FILE DEVICE NUMBER
C     RCRD  =  RECORD DEVICE NUMBER  (OUTPUT DATA FILE FOR RECORDING
C                 SCREEN IMAGES AND COMMENTS)
C     RESTRT  =  RESTART FILE DEVICE NUMBER (UNFORMATTED OUTPUT DATA
C                 FILE FOR USE IN RESTARTING AT A LATER DATE)
C
C     ILINES  =  THE TOTAL NUMBER OF LINES ON THE TERMINAL SCREEN.
C                 IT MUST SATISFY:  1 < ILINES < 58
C     IWIDTH  =  THE NUMBER OF COLUMNS ON THE TERMINAL SCREEN.
C                 IT MUST SATISFY:  1 < IWIDTH < 136
C     IPLT    =  THE NUMBER OF LINES ALLOCATED TO PLOTTING THE CURVES.
C                 IT MUST SATISFY:  1 < IPLT   < 58
C     IDATA   =  THE NUMBER OF LINES ABOVE THE SCREEN BOTTOM AT WHICH
C                 THE NUMERICAL DATA REGION BEGINS.  IT MUST BE GREATER
C                 THAN IPROMP BY 6 OR MORE.
C     IPROMP  =  THE NUMBER OF LINES ABOVE THE SCREEN BOTTOM AT WHICH
C                 THE PROMPTING COMMANDS ARE GIVEN (AT LEAST 2).
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     EXTERNAL REFERENCES (FUNCTION,SUBROUTINE,COMMON)
C
C     EXTERNAL REFS       POS,         SUBAC,       SGRAPH,      SUBCC
C     EXTERNAL REFS       SUBCD,       SUBCH,       SUBCO,       SUBCW
C     EXTERNAL REFS       SUBCCH,      CHKCMP,      BLSCRN,      SUBDC
C     EXTERNAL REFS       SUBDG,       SUBDI,       SUBDM,       SUBDO
C     EXTERNAL REFS       SUBDS,       SUBDX,       SUBDCH,      NUMDIG
C     EXTERNAL REFS       SUBEG,       INHELP,      CHKERR,      SUBFL
C     EXTERNAL REFS       SUBFO,       SUBGO,       SUBHA,       SUBHE
C     EXTERNAL REFS       SUBID,       SUBIH,       SUBII,       SUBIP
C     EXTERNAL REFS       DIALOG,      SUBLC,       SUBLD,       SUBLI
C     EXTERNAL REFS       SUBLO,       SUBLP,       NRML,        SGAMMA
C     EXTERNAL REFS       SUBMU,       SUBNE,       SUBNO,       SUBOU
C     EXTERNAL REFS       OPCOPY,      SCROLL,      ZERO,        SUBPA
C     EXTERNAL REFS       SUBPL,       SUBPCH,      SAMPLE,      SSMPUD
C     EXTERNAL REFS       SUBRC,       SUBRD,       SUBRE,       SUBRO
C     EXTERNAL REFS       SUBRP,       SUBRS,       SUBRW,       MAKROM
C     EXTERNAL REFS       PCURSR,      SUBSE,       SUBSH,       SUBST
C     EXTERNAL REFS       SUBTC,       SUBTN,       SUBTY,       DFAULT
C     EXTERNAL REFS       SUBUN,       SUBUSR,      SCMUPD,      SGRUPD
C     EXTERNAL REFS       SUBWA,       SUBZO
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     EXTERNAL FUNCTIONS AND SUBROUTINES
C
      EXTERNAL            F
      DOUBLE PRECISION    F
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     HOLLERITH STRING VARIABLES
C
      INTEGER             IBLNK
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     NON-COMMON VARIABLES
C
C     SETS                I,           J,           OK,          NL
C     SETS                LGO,         MCALRD,      NCALLS,      OUTPTD
C     SETS                ITYPE,       ITXT
C
      DOUBLE PRECISION    V1(3),       V2(3),       DARG
      INTEGER             I,           J,           ND,          NL
      INTEGER             NUM,         DEN,         HLP,         IWIDTH
      INTEGER             RCRD,        IARG,        IARGP,       NCALLS
      INTEGER             ICOM,        ILINES,      IPROMP,      GRAPHC
      INTEGER             OUTPT,       OUTPTD,      ITYPE,       IDATA
      INTEGER             IPLT,        INPT,        RESTRT
      INTEGER             ITXT(72)
      LOGICAL             OK,          LGO,         LMAG,        LSHIFT
      LOGICAL             MCALRD,      LSAMPL,      LCOMP,       LZERO
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / CB     /
C
C     UNUSED              CBD,         ICBD,        LCBD,        CBDSW
C     UNUSED              CBDU
C
      DOUBLE PRECISION    CBDSW,       CBD,         CBDU
      INTEGER             ICBD
      LOGICAL             LCBD
      COMMON / CB     /   CBDSW,       CBD(3),      CBDU(3),     ICBD
      COMMON / CB     /   LCBD
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / IO     /
C
C     SETS                RECORD,      GRAPHD,      HELPD,       RSTRTD
C     SETS                INPUTD
C
      INTEGER             INPUTD,      GRAPHD,      HELPD,       RECORD
      INTEGER             RSTRTD
      COMMON / IO     /   INPUTD,      GRAPHD,      HELPD,       RECORD
      COMMON / IO     /   RSTRTD
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / LOG    /
C
      INTEGER             LCHN
      COMMON / LOG    /   LCHN
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / LOGCOM /
C
C     UNUSED              LDF,         LDEF,        LPLT
C
      LOGICAL             LDF,         LPLT,        LDEF
      COMMON / LOGCOM /   LDF(7),      LPLT(7),     LDEF(5377)
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / FUNCOM /
C
C     UNUSED              DF,          FS,          XS,          DFMNMX
C
      DOUBLE PRECISION    XS,          FS,          DF,          DFMNMX
      COMMON / FUNCOM /   XS(5377),    FS(5377),    DF(135,7)
      COMMON / FUNCOM /   DFMNMX(2,7)
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / ERRCOM /
C
C     SETS                ERR,         ERRCOD
C
      INTEGER             ERRCOD
      LOGICAL             ERR
      COMMON / ERRCOM /   ERRCOD,      ERR
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / PLTCOM /
C
C     UNUSED         SCALE,       IPLOT,       ISCRN1,      ISCRN2
C
      INTEGER             IPLOT,       ISCRN1,      ISCRN2
      REAL                SCALE
      COMMON / PLTCOM /   SCALE(7),    IPLOT(135,7),ISCRN1(135,57)
      COMMON / PLTCOM /   ISCRN2(135,57)
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / LOADIO /
C
C     UNUSED              CLOAD,       DLOAD,       PLOAD
C
      INTEGER             PLOAD,       DLOAD,       CLOAD
      COMMON / LOADIO /   PLOAD,       DLOAD,       CLOAD
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / SCREEN /
C
C     SETS                ILP,         LINES,       IPRMPT,      IDSPLA
C     SETS                OUTPUT,      LSCRN,       WIDTH
C
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / OPTION /
C
C     UNUSED              NH,          ROPDR1,      ROPDR2,      ILEFT
C     UNUSED              IRIGHT,      OPCMP,       OPSPL,       ROPSTW
C
C     SETS                IOPDM,       ROPDI,       ROPPNT
C
      DOUBLE PRECISION    ROPDI,       ROPPNT,      ROPDR1,      ROPDR2
      DOUBLE PRECISION    ROPSTS,      ROPSTW,      ROPUDI
      INTEGER             NH,          NW,          ILEFT,       IRIGHT
      INTEGER             IOPDM,       IOPSH,       IOPSS,       IOPWN
      LOGICAL             OPDC,        OPDS,        OPDX,        OPCMP
      LOGICAL             OPSPL,       OPDF1,       OPDF2
      COMMON / OPTION /   ROPDI(3,2),  ROPPNT(3,2), ROPDR1(3,2)
      COMMON / OPTION /   ROPDR2(3,2), ROPSTS(2),   ROPSTW(2)
      COMMON / OPTION /   ROPUDI(3,2), NH(2),       NW(2)
      COMMON / OPTION /   ILEFT(2),    IRIGHT(2),   IOPDM(2)
      COMMON / OPTION /   IOPSH(2),    IOPSS(2),    IOPWN(2),    OPDC(2)
      COMMON / OPTION /   OPDS(2),     OPDX(2),     OPCMP(2)
      COMMON / OPTION /   OPSPL(2),    OPDF1(7,2),  OPDF2(7,2)
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / NRMLZE /
C
C     SETS                NORMAL
C
      LOGICAL             NORMAL
      COMMON / NRMLZE /   NORMAL
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / ROOM   /
C
C     SETS                ILPUSR,      IDSUSR
C
      INTEGER             ILPUSR,      IDSUSR
      COMMON / ROOM   /   ILPUSR,      IDSUSR
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / HELPER /
C
C     UNUSED              IHELP,       JHELP
C
C     SETS                HELP
C
      INTEGER             HELP,        JHELP1,      JHELP2,      JHELP3
      INTEGER             JHELP,       IHELP
      COMMON / HELPER /   HELP,        JHELP1,      JHELP2,      JHELP3
      COMMON / HELPER /   JHELP(99,2), IHELP(72,99)
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / USER   /
C
C     UNUSED              N,           ETA,         ADD,         IROUND
C
      DOUBLE PRECISION    ETA
      INTEGER             IROUND,      N
      LOGICAL             ADD
      COMMON / USER   /   ETA,         IROUND,      N,           ADD
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / PLOWN  /
C
C     SETS                BL,          BR,          NUMBR,       TIME
C     SETS                DATE,        FRAME,       COLOR,       LMARK
C     SETS                NUMRCL,      LBLS,        ITITLE,      IBOTTM
C
      INTEGER             ITITLE,      IBOTTM,      NUMBR,       BL
      INTEGER             BR
      LOGICAL             FRAME,       COLOR,       NUMRCL,      LMARK
      LOGICAL             LBLS,        DATE,        TIME
      COMMON / PLOWN  /   ITITLE(72),  IBOTTM(72),  NUMBR,       FRAME
      COMMON / PLOWN  /   COLOR,       NUMRCL,      LMARK,       LBLS
      COMMON / PLOWN  /   DATE,        TIME,        BL(72),      BR(72)
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / FOOWN  /
C
C     SETS                LFO
C
      LOGICAL             LFO
      COMMON / FOOWN  /   LFO
C
      DATA IBLNK /1H /
      DATA MCALRD /.FALSE./
C-----------------------------------------------------------------------
C
C WRITE IDENTIFYING STENCIL
C
C-----------------------------------------------------------------------
      CALL BLSCRN(OUTPT)
      CALL PCURSR(OUTPT,1,1)
      IF (MCALRD) WRITE (OUTPT,14000)
      IF (.NOT.MCALRD) WRITE (OUTPT,16000)
      WRITE (OUTPT,18000)
C-----------------------------------------------------------------------
C
C CHECK SCREEN PARAMETERS FOR CONSISTENCY AND ADMISSIBILITY
C
C-----------------------------------------------------------------------
      OK = .TRUE.
      IF (ILINES.GT.10) GO TO 100
      WRITE (OUTPT,20000)
      OK = .FALSE.
  100 CONTINUE
      IF (ILINES.LT.58) GO TO 200
      WRITE (OUTPT,22000)
      OK = .FALSE.
  200 CONTINUE
      IF (IWIDTH.GT.0) GO TO 300
      WRITE (OUTPT,24000)
      OK = .FALSE.
  300 CONTINUE
      IF (IWIDTH.LT.136) GO TO 400
      WRITE (OUTPT,26000)
      OK = .FALSE.
  400 CONTINUE
      IF (IPLT.GT.0) GO TO 500
      WRITE (OUTPT,28000)
      OK = .FALSE.
  500 CONTINUE
      IF (IPROMP.GT.1) GO TO 600
      WRITE (OUTPT,30000)
      OK = .FALSE.
  600 CONTINUE
      IF (IPROMP.LT.ILINES-IPLT-6) GO TO 700
      WRITE (OUTPT,32000)
      OK = .FALSE.
  700 CONTINUE
      IF (IDATA.GT.IPROMP+5) GO TO 800
      WRITE (OUTPT,34000)
      OK = .FALSE.
  800 CONTINUE
      IF (IDATA.LT.ILINES-IPLT) GO TO 900
      WRITE (OUTPT,36000)
      OK = .FALSE.
  900 CONTINUE
      IF (IPLT.LT.ILINES-8) GO TO 1000
      WRITE (OUTPT,38000)
      OK = .FALSE.
 1000 CONTINUE
      IF (OK) GO TO 1100
      WRITE (OUTPT,40000) ILINES,IWIDTH,IPLT,IDATA,IPROMP
      WRITE (OUTPT,42000)
      GO TO 8300
 1100 CONTINUE
C-----------------------------------------------------------------------
C
C COPY CHANNEL NUMBERS, SCREEN PARAMETERS, AND SET FLAGS
C
C-----------------------------------------------------------------------
      INPUTD = INPT
      OUTPTD = OUTPT
      GRAPHD = GRAPHC
      HELPD  = HLP
      RECORD = RCRD
      RSTRTD = RESTRT
      LFO    = .FALSE.
      LGO    = .FALSE.
      LSCRN  = .FALSE.
      LINES  = ILINES
      WIDTH  = IWIDTH
      IDSUSR = IDATA
      IDSPLA = IDATA
      ILPUSR = IPLT
      ILP    = IPLT
      IPRMPT = IPROMP
      HELP   = HELPD
      OUTPUT = OUTPTD
      IF (MCALRD) GO TO 1400
      MCALRD = .TRUE.
C-----------------------------------------------------------------------
C
C COMPUTE ROUND-OFF CHARACTERISTICS AND PRINT THEM
C
C-----------------------------------------------------------------------
      CALL NUMDIG(ND)
      WRITE (OUTPT,44000) ND
C-----------------------------------------------------------------------
C
C  SET LOGICAL VARIABLES, COMMON BLOCKS, AND DEFAULT VECTORS, BEFORE
C   STARTING
C
C-----------------------------------------------------------------------
      NORMAL = .TRUE.
      NCALLS = 0
           DO 1200 I = 1,2
           IOPDM(I)    = 2
           ROPPNT(1,I) = 0.0D0
           ROPPNT(2,I) = 0.0D0
           ROPPNT(3,I) = 0.0D0
           ROPDI(1,I)  = 1.0D0
           ROPDI(2,I)  = 1.0D0
           ROPDI(3,I)  = 0.0D0
 1200      CONTINUE
      CALL DFAULT
      CALL NRML
C-----------------------------------------------------------------------
C
C  SET PLOTTING DEFAULTS:
C
C-----------------------------------------------------------------------
           DO 1300 I = 1,72
           ITITLE(I) = IBLNK
           IBOTTM(I) = IBLNK
           BL(I)     = IBLNK
           BR(I)     = IBLNK
 1300      CONTINUE
      NUMBR     = 0
      TIME      = .FALSE.
      DATE      = .FALSE.
      COLOR     = .TRUE.
      LMARK     = .FALSE.
      LBLS      = .TRUE.
      FRAME     = .TRUE.
      NUMRCL    = .TRUE.
C-----------------------------------------------------------------------
C
C  INPUT HELP DOCUMENTATION
C
C-----------------------------------------------------------------------
      CALL INHELP
C PRINT TOP LINE OF THE NEWS
      NL = 7+JHELP1+JHELP2+JHELP3
      CALL POS(HLP,NL)
      WRITE (OUTPT,10000)
      READ (HLP,12000) (ITXT(J),J=1,72)
      WRITE (OUTPT,12000) (ITXT(J),J=1,72)
 1400 CONTINUE
C-----------------------------------------------------------------------
C
C  BEGIN MAIN LOOP
C
C  'DIALOG' PROMPTS FOR INPUT, THEN READS AND RECOGNIZES THE INPUT.
C
C-----------------------------------------------------------------------
 1500 CALL DIALOG(ICOM,IARG,IARGP,DARG,V1,V2,IOPDM,INPUTD)
      ERR    = .FALSE.
      ERRCOD = 0
      GO TO (1600,1700,1800,1900,2000,2100,2200,2300,2400,2500,2600,
     X     2700,2800,2900,3000,3100,3200,3300,3400,3500,3600,3700,3800,
     X     3900,4000,4100,4200,4300,4400,4500,4600,4700,4800,4900,5000,
     X     5100,5200,5300,5400,5500,5600,5700,5800,5900,6000,6100,6200,
     X     6300,6400,6500,6600,6700,6800,6900,7000,7100,7200,7300,7400,
     X     7500,7600,7700,7800),ICOM
C-----------------------------------------------------------------------
C
C  EXECUTE THE APPROPRIATE SUBROUTINE.  MOST SUBROUTINE NAMES HAVE
C   THE FORM:  SUB + (FIRST TWO LETTERS OF THE COMMAND)
C
C-----------------------------------------------------------------------
 1600 CALL SUBAC(ITYPE,IARG,OPDF1,OPDF2)
      GO TO 7900
 1700 CALL SUBCCH(ITYPE,1,DARG)
      GO TO 7900
 1800 CALL SUBCCH(ITYPE,2,DARG)
      GO TO 7900
 1900 CALL SUBCCH(ITYPE,3,DARG)
      GO TO 7900
 2000 CALL SUBCC(ITYPE,IARG,IARGP,INPUTD,OUTPTD,GRAPHD,RECORD,RSTRTD)
      GO TO 7900
 2100 CALL SUBCD(ITYPE,V1)
      GO TO 7900
 2200 CALL SUBCH(ITYPE,DARG)
      GO TO 7900
 2300 CALL SUBCO(ITYPE,IARG)
      GO TO 7900
 2400 CALL SUBCW(ITYPE,IARG,IOPWN)
      GO TO 7900
 2500 CALL SUBDCH(ITYPE,1,DARG)
      GO TO 7900
 2600 CALL SUBDCH(ITYPE,2,DARG)
      GO TO 7900
 2700 CALL SUBDCH(ITYPE,3,DARG)
      GO TO 7900
 2800 CALL SUBDC(ITYPE,OPDC)
      GO TO 7900
 2900 CALL SUBDG(ITYPE,IARG,OPDF1)
      GO TO 7900
 3000 CALL SUBDI(ITYPE,IARG,IOPSS,IOPWN)
      GO TO 7900
 3100 CALL SUBDM(ITYPE,IARG,IOPDM,ROPDI,ROPUDI,ROPPNT)
      GO TO 7900
 3200 CALL SUBDO(ITYPE,IOPSS,IOPWN)
      GO TO 7900
 3300 CALL SUBDS(ITYPE,OPDS)
      GO TO 7900
 3400 CALL SUBDX(ITYPE,OPDX)
      GO TO 7900
 3500 CALL SUBEG(ITYPE,IARG,OPDF1,OPDF2)
      GO TO 7900
 3600 GO TO 8300
 3700 CALL SUBFL(ITYPE)
      GO TO 7900
 3800 CALL SUBFO(ITYPE,LGO)
      GO TO 7900
 3900 CALL SUBGO(ITYPE,LGO)
      GO TO 7900
 4000 CALL SUBHA(ITYPE,IOPSS,IOPWN)
      GO TO 7900
 4100 CALL SUBHE(ITYPE,IARG,2)
      GO TO 7900
 4200 CALL SUBHE(ITYPE,ICOM,1)
      GO TO 7900
 4300 CALL SUBID(ITYPE,V1,ROPDI,ROPUDI,IOPDM)
      GO TO 7900
 4400 CALL SUBIH(ITYPE,DARG,ROPSTS,NW)
      GO TO 7900
 4500 CALL SUBII(ITYPE,V1,V2)
      GO TO 7900
 4600 CALL SUBIP(ITYPE,V1,ROPPNT,IOPDM)
      GO TO 7900
 4700 CALL SUBLC(ITYPE,IARG)
      GO TO 7900
 4800 CALL SUBLD(ITYPE,IARG)
      GO TO 7900
 4900 CALL SUBLI(ITYPE)
      GO TO 7900
 5000 CALL SUBLO(ITYPE,IARG)
      GO TO 7900
 5100 CALL SUBLP(ITYPE,IARG)
      GO TO 7900
 5200 CALL SUBMU(ITYPE,IARG,IOPSS,IOPWN)
      GO TO 7900
 5300 CALL SUBNE(ITYPE)
      GO TO 7900
 5400 CALL SUBNO(ITYPE)
      GO TO 7900
 5500 CALL SUBOU(ITYPE,RECORD,NCALLS,LGO)
      GO TO 7900
 5600 CALL SUBPCH(ITYPE,1,DARG)
      GO TO 7900
 5700 CALL SUBPCH(ITYPE,2,DARG)
      GO TO 7900
 5800 CALL SUBPCH(ITYPE,3,DARG)
      GO TO 7900
 5900 CALL SUBPA(ITYPE,IARG)
      GO TO 7900
 6000 CALL SUBPL(ITYPE,INPUTD,NCALLS)
      GO TO 7900
 6100 CONTINUE
      STOP
 6200 CALL SUBRC(ITYPE,IARG)
      GO TO 7900
 6300 CALL SUBRD(ITYPE,IARG)
      GO TO 7900
 6400 CALL SUBRE(ITYPE,NCALLS,LGO)
      IF (.NOT.LSCRN) GO TO 7900
      LSCRN = .FALSE.
      CALL SGRAPH(GRAPHD,NCALLS,LGO)
      GO TO 7900
 6500 CALL SUBRO(ITYPE,V1,ROPDI,ROPUDI,IOPDM)
      GO TO 7900
 6600 CALL SUBRP(ITYPE,IARG)
      GO TO 7900
 6700 CALL SUBRS(ITYPE,LSCRN)
      GO TO 7900
 6800 CALL SUBRW(ITYPE,IARG)
      GO TO 7900
 6900 CALL SUBSE(ITYPE)
      GO TO 7900
 7000 CALL SUBSH(ITYPE,IARG,IOPSH)
      GO TO 7900
 7100 CALL SUBST(ITYPE,NCALLS,LGO)
      GO TO 7900
 7200 CALL SUBTC(ITYPE,IARG,INPUTD)
      GO TO 7900
 7300 CALL SUBTN(ITYPE,RECORD,INPUTD,OUTPUT,GRAPHD,WIDTH,LSCRN)
      GO TO 7900
 7400 CALL SUBTY(ITYPE,IARG,IARGP,INPUTD,GRAPHD)
      GO TO 7900
 7500 CALL SUBUN(ITYPE)
      GO TO 7900
 7600 CALL SUBUSR
      LSCRN = .FALSE.
      ITYPE = 4
      GO TO 7900
 7700 CALL SUBWA(ITYPE)
      GO TO 7900
 7800 CALL SUBZO(ITYPE,IARG,IOPSS)
      GO TO 7900
C-----------------------------------------------------------------------
C
C  SET THE LOGICAL VARIABLE LGO TO .FALSE. IF OPTION IS OF TYPE 1.
C   IF OPTION IS OF TYPE 2, CALL SGAMMA
C
C-----------------------------------------------------------------------
 7900 IF ( ITYPE.EQ.1 ) LGO = .FALSE.
      IF ( ITYPE.EQ.1 ) LSCRN = .FALSE.
      IF ( ITYPE.EQ.2.AND.LGO ) CALL SGAMMA(LGO,NUM,DEN)
C-----------------------------------------------------------------------
C
C  CHECK FOR ERROR - OUTPUT APPROPRIATE MESSAGE IF ERR = .TRUE.
C   IF ERR = .TRUE.  OR  LGO = .FALSE.  REQUEST ANOTHER COMMAND.
C
C-----------------------------------------------------------------------
      CALL CHKERR
      IF ( ERR ) GO TO 1500
C-----------------------------------------------------------------------
C
C IF A SCREEN UPDATE IS REQUIRED (ICOM = 52) AND  GO  IS PENDING,
C  CALL SGRAPH TO DISPLAY THE OLD INFORMATION
C
C-----------------------------------------------------------------------
      IF (.NOT.LGO.AND.ICOM.EQ.52) CALL SGRAPH(GRAPHD,NCALLS,LGO)
C-----------------------------------------------------------------------
C
C CHECK IF A  GO  COMMAND IS REQUIRED BEFORE FURTHER COMPUTATION
C
C-----------------------------------------------------------------------
      IF (.NOT.LGO) GO TO 1500
C-----------------------------------------------------------------------
C
C THE NEXT STEP DEPENDS ON THE TYPE OF COMMAND JUST INPUT
C
C-----------------------------------------------------------------------
      GO TO (1500,8000,8100,1500),ITYPE
C-----------------------------------------------------------------------
C
C  CHECK TO SEE IF COMPUTATION OR SAMPLING CHANGES ARE NECESSARY
C
C-----------------------------------------------------------------------
 8000 CALL CHKCMP(LCOMP,LMAG,LSHIFT,LSAMPL,LZERO,NUM,DEN)
C-----------------------------------------------------------------------
C
C  IF CHKCMP() RETURNS A VALUE OF TRUE FOR LCOMP, LMAG, LSHIFT, OR
C   LSAMPL, THEN CALL THE APPROPRIATE UPDATING ROUTINE.
C
C-----------------------------------------------------------------------
      IF ( LMAG.OR.LSHIFT ) CALL SSMPUD(LMAG,LSHIFT,NUM,DEN)
      IF ( LSAMPL ) CALL SAMPLE
      IF ( LZERO  ) CALL ZERO
      IF ( LCOMP  ) CALL SCMUPD(F,NCALLS)
 8100 CONTINUE
C-----------------------------------------------------------------------
C
C  IF CROSS DERIVATIVES ARE TO BE PLOTTED THEN PREY ON THE GRAPHICS
C   DISPLAY AREA TO MAKE ROOM FOR THE NUMERICAL OUTPUT IF NECESSARY
C
C-----------------------------------------------------------------------
      CALL MAKROM
C-----------------------------------------------------------------------
C
C  SET UP THE GRAPHICS DATA WHICH IS THEN CONVERTED INTO PLOTTING
C   COMMANDS BY THE SGRAPH SUBROUTINE.
C
C-----------------------------------------------------------------------
      CALL SGRUPD(ICOM)
C-----------------------------------------------------------------------
C
C  PLOT THE DATA, THEN RETURN TO TOP OF PROGRAM FOR NEW COMMANDS
C
C-----------------------------------------------------------------------
      CALL SGRAPH(GRAPHD,NCALLS,LGO)
C-----------------------------------------------------------------------
C
C IF LOGGING IS REQUIRED WRITE DATA IN SCROLLING MODE
C
C-----------------------------------------------------------------------
      IF (LCHN.EQ.0) GO TO 8200
      WRITE (LCHN,46000)
      CALL SCROLL(LCHN,NCALLS,LGO)
      WRITE (LCHN,46000)
 8200 CONTINUE
C-----------------------------------------------------------------------
C
C UPDATE OPTIONS AND FLAGS
C
C-----------------------------------------------------------------------
      CALL OPCOPY
      GO TO 1500
 8300 CONTINUE
      RETURN
     X 25H Version 1.0 -  15-JUN-84//)
     X   10H PLOT   = ,I4/10H NUMRCL = ,I4/10H PROMPT = ,I4/)
     X 24H Leaving MICROSCOPE ... //)
      END
      SUBROUTINE CHKERR
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C  ROUTINE:  CHKERR
C  PURPOSE:  TO OUTPUT ERROR MESSAGES TO DEVICE OUTPUT
C
      INTEGER             ERRCOD
      LOGICAL             ERR
      COMMON / ERRCOM /   ERRCOD,      ERR
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      IF (.NOT.ERR) GO TO 2700
      GO TO (100,200,300,400,500,600,700,800,900,1000,1100,1200,1300,
     X     1400,1500,1600,1700,1800,1900,2000,2100,2200,2300,2400,2500),
     X     ERRCOD
  100 WRITE (OUTPUT,10000)
      GO TO 2600
  200 WRITE (OUTPUT,12000)
      GO TO 2600
  300 WRITE (OUTPUT,14000)
      GO TO 2600
  400 WRITE (OUTPUT,16000)
      GO TO 2600
  500 WRITE (OUTPUT,18000)
      GO TO 2600
  600 WRITE (OUTPUT,20000)
      GO TO 2600
  700 WRITE (OUTPUT,22000)
      GO TO 2600
  800 WRITE (OUTPUT,24000)
      GO TO 2600
  900 WRITE (OUTPUT,26000)
      GO TO 2600
 1000 WRITE (OUTPUT,28000)
      GO TO 2600
 1100 WRITE (OUTPUT,30000)
      GO TO 2600
 1200 WRITE (OUTPUT,32000)
      GO TO 2600
 1300 WRITE (OUTPUT,34000)
      GO TO 2600
 1400 WRITE (OUTPUT,36000)
      GO TO 2600
 1500 WRITE (OUTPUT,38000)
      GO TO 2600
 1600 WRITE (OUTPUT,40000)
      GO TO 2600
 1700 WRITE (OUTPUT,42000)
      GO TO 2600
 1800 WRITE (OUTPUT,44000)
      GO TO 2600
 1900 WRITE (OUTPUT,46000)
      GO TO 2600
 2000 WRITE (OUTPUT,48000)
      GO TO 2600
 2100 WRITE (OUTPUT,50000)
      GO TO 2600
 2200 WRITE (OUTPUT,52000)
      GO TO 2600
 2300 WRITE (OUTPUT,56000)
      GO TO 2600
 2400 WRITE (OUTPUT,54000)
      GO TO 2600
 2500 WRITE (OUTPUT,56000)
C
 2600 CONTINUE
      LSCRN = .FALSE.
 2700 CONTINUE
      RETURN
C
C  FORMAT STATEMENTS
C
      END
      SUBROUTINE DIALOG(ICOM,IARG,IARGP,DARG,V1,V2,IOPDM,INPUTD)
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C  ROUTINE:  DIALOG
C  PURPOSE:  TO PROMPT FOR, INPUT, AND RECOGNIZE, COMMANDS TO THE
C             MICROSCOPE PROGRAM.
C
C  ARGUMENTS:
C
C     ICOM    = THE NUMBER CORRESPONDING TO THE INPUTTED COMMAND
C                (THE ORDER IS DEFINED BY THE ORDER IN THE LIST
C                 OF OPTIONS.  IT IS IN ALPHABETICAL ORDER)
C     IARG    = THE INTEGER ARGUMENT, IF ANY, THAT ACCOMPANIES THE
C                ICOM'TH COMMAND.
C     IARGP   = THE SECOND INTEGER ARGUMENT IF ANY
C     DARG    = THE DOUBLE PRECISION ARGUMENT, IF ANY, THAT ACCOMPANIES
C                THE ICOM'TH COMMAND.
C     V1(3)   = THE DOUBLE PRECISION VECTOR, IF ANY, THAT ACCOMPANIES
C                THE ICOM'TH COMMAND.  NOTE THAT THE LENGTH OF THE
C                VECTOR (1,2 OR 3) WILL DEPEND ON THE CURRENT VALUE OF
C                IOPDM(2).
C     V2(3)   = SIMILAR TO V1(3).
C     IOPDM(2)= THE DIMENSION OF THE DOMAIN (1,2 OR 3)
C
C  THE KTYPE() ARRAY VALUES HAVE THE FOLLOWING MEANING:
C     KTYPE() = 1  :  PUT DIALOG INTO HELP MODE WHERE IT RECOGNIZES THE
C                      THE NEXT COMMAND AS THE ONE ON WHICH FURTHER
C                      INFORMATION IS DESIRED.
C               2  :  1 INTEGER ARGUMENT  (IARG)
C               3  :  1 DOUBLE PRECISION ARGUMENT  (DARG)
C               4  :  1,2 OR 3 DOUBLE PRECISION ARGUMENTS (V1())
C               5  :  2,4 OR 6 DOUBLE PRECISION ARGUMENTS (V1(), V2())
C               6  :  NO ARGUMENTS NECESSARY
C               7  :  2 INTEGER ARGUMENTS (IARG,IARGP)
C
C  NOTE:  THERE ARE TWO SCREEN EDITING ROUTINES WHICH ARE CALLED BY
C          DIALOG.  DEPENDING ON THE TYPE OF DEVICE, THE APPROPRIATE
C          ROUTINES (HAVING THESE NAMES) MUST BE LOADED FROM A
C          SEPARATE SOURCE FILE.  THE TWO ROUTINES AND THEIR
C          RESPECTIVE PURPOSES ARE:
C
C    CLSCRN(U,I,J)    :  CLEAR THE SCREEN BELOW THE CURSOR POSITION WITH
C                         SCREEN COORDINATES (I,J), ON DEVICE U.
C    PCURSR(U,I,J)    :  POSITION THE CURSOR AT SCREEN COORDINATES (I,J)
C                         ON DEVICE U.
C
      INTEGER             IQ,          PLS,         ICMNDS(99,2)
      DOUBLE PRECISION    V1(3),       V2(3),       DARG
      INTEGER             I,           J,           JP
      INTEGER             IOPDM(2),    MODE,        IARG,        IARGP
      INTEGER             MHELP,       ICOM,        NLINES,      NCMND
      INTEGER             IPROMT,      JPROMT,      KTYPE(99),   CHAR1
      INTEGER             CHAR2,       DMNSN,       INPUTD
      LOGICAL             ERR
      INTEGER             LCHN
      COMMON / LOG    /   LCHN
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      INTEGER             HELP,        JHELP1,      JHELP2,      JHELP3
      INTEGER             JHELP,       IHELP
      COMMON / HELPER /   HELP,        JHELP1,      JHELP2,      JHELP3
      COMMON / HELPER /   JHELP(99,2), IHELP(72,99)
      DATA  NCMND /0/
      DATA  IQ /1H?/
      DATA  PLS /1H+/
      DATA  ICMNDS( 1,1),ICMNDS( 1,2),KTYPE(1)  / 1HA, 1HC, 2 /
      DATA  ICMNDS( 2,1),ICMNDS( 2,2),KTYPE(2)  / 1HC, 1H1, 3 /
      DATA  ICMNDS( 3,1),ICMNDS( 3,2),KTYPE(3)  / 1HC, 1H2, 3 /
      DATA  ICMNDS( 4,1),ICMNDS( 4,2),KTYPE(4)  / 1HC, 1H3, 3 /
      DATA  ICMNDS( 5,1),ICMNDS( 5,2),KTYPE(5)  / 1HC, 1HC, 7 /
      DATA  ICMNDS( 6,1),ICMNDS( 6,2),KTYPE(6)  / 1HC, 1HD, 4 /
      DATA  ICMNDS( 7,1),ICMNDS( 7,2),KTYPE(7)  / 1HC, 1HH, 3 /
      DATA  ICMNDS( 8,1),ICMNDS( 8,2),KTYPE(8)  / 1HC, 1HO, 2 /
      DATA  ICMNDS( 9,1),ICMNDS( 9,2),KTYPE(9)  / 1HC, 1HW, 2 /
      DATA  ICMNDS(10,1),ICMNDS(10,2),KTYPE(10) / 1HD, 1H1, 3 /
      DATA  ICMNDS(11,1),ICMNDS(11,2),KTYPE(11) / 1HD, 1H2, 3 /
      DATA  ICMNDS(12,1),ICMNDS(12,2),KTYPE(12) / 1HD, 1H3, 3 /
      DATA  ICMNDS(13,1),ICMNDS(13,2),KTYPE(13) / 1HD, 1HC, 6 /
      DATA  ICMNDS(14,1),ICMNDS(14,2),KTYPE(14) / 1HD, 1HG, 2 /
      DATA  ICMNDS(15,1),ICMNDS(15,2),KTYPE(15) / 1HD, 1HI, 2 /
      DATA  ICMNDS(16,1),ICMNDS(16,2),KTYPE(16) / 1HD, 1HM, 2 /
      DATA  ICMNDS(17,1),ICMNDS(17,2),KTYPE(17) / 1HD, 1HO, 6 /
      DATA  ICMNDS(18,1),ICMNDS(18,2),KTYPE(18) / 1HD, 1HS, 6 /
      DATA  ICMNDS(19,1),ICMNDS(19,2),KTYPE(19) / 1HD, 1HX, 6 /
      DATA  ICMNDS(20,1),ICMNDS(20,2),KTYPE(20) / 1HE, 1HG, 2 /
      DATA  ICMNDS(21,1),ICMNDS(21,2),KTYPE(21) / 1HE, 1HX, 6 /
      DATA  ICMNDS(22,1),ICMNDS(22,2),KTYPE(22) / 1HF, 1HL, 6 /
      DATA  ICMNDS(23,1),ICMNDS(23,2),KTYPE(23) / 1HF, 1HO, 6 /
      DATA  ICMNDS(24,1),ICMNDS(24,2),KTYPE(24) / 1HG, 1HO, 6 /
      DATA  ICMNDS(25,1),ICMNDS(25,2),KTYPE(25) / 1HH, 1HA, 6 /
      DATA  ICMNDS(26,1),ICMNDS(26,2),KTYPE(26) / 1HH, 1HE, 1 /
      DATA  ICMNDS(27,1),ICMNDS(27,2),KTYPE(27) / 1HH, 1HS, 6 /
      DATA  ICMNDS(28,1),ICMNDS(28,2),KTYPE(28) / 1HI, 1HD, 4 /
      DATA  ICMNDS(29,1),ICMNDS(29,2),KTYPE(29) / 1HI, 1HH, 3 /
      DATA  ICMNDS(30,1),ICMNDS(30,2),KTYPE(30) / 1HI, 1HI, 5 /
      DATA  ICMNDS(31,1),ICMNDS(31,2),KTYPE(31) / 1HI, 1HP, 4 /
      DATA  ICMNDS(32,1),ICMNDS(32,2),KTYPE(32) / 1HL, 1HC, 2 /
      DATA  ICMNDS(33,1),ICMNDS(33,2),KTYPE(33) / 1HL, 1HD, 2 /
      DATA  ICMNDS(34,1),ICMNDS(34,2),KTYPE(34) / 1HL, 1HI, 6 /
      DATA  ICMNDS(35,1),ICMNDS(35,2),KTYPE(35) / 1HL, 1HO, 2 /
      DATA  ICMNDS(36,1),ICMNDS(36,2),KTYPE(36) / 1HL, 1HP, 2 /
      DATA  ICMNDS(37,1),ICMNDS(37,2),KTYPE(37) / 1HM, 1HU, 2 /
      DATA  ICMNDS(38,1),ICMNDS(38,2),KTYPE(38) / 1HN, 1HE, 6 /
      DATA  ICMNDS(39,1),ICMNDS(39,2),KTYPE(39) / 1HN, 1HO, 6 /
      DATA  ICMNDS(40,1),ICMNDS(40,2),KTYPE(40) / 1HO, 1HU, 6 /
      DATA  ICMNDS(41,1),ICMNDS(41,2),KTYPE(41) / 1HP, 1H1, 3 /
      DATA  ICMNDS(42,1),ICMNDS(42,2),KTYPE(42) / 1HP, 1H2, 3 /
      DATA  ICMNDS(43,1),ICMNDS(43,2),KTYPE(43) / 1HP, 1H3, 3 /
      DATA  ICMNDS(44,1),ICMNDS(44,2),KTYPE(44) / 1HP, 1HA, 2 /
      DATA  ICMNDS(45,1),ICMNDS(45,2),KTYPE(45) / 1HP, 1HL, 6 /
      DATA  ICMNDS(46,1),ICMNDS(46,2),KTYPE(46) / 1HQ, 1HU, 6 /
      DATA  ICMNDS(47,1),ICMNDS(47,2),KTYPE(47) / 1HR, 1HC, 2 /
      DATA  ICMNDS(48,1),ICMNDS(48,2),KTYPE(48) / 1HR, 1HD, 2 /
      DATA  ICMNDS(49,1),ICMNDS(49,2),KTYPE(49) / 1HR, 1HE, 6 /
      DATA  ICMNDS(50,1),ICMNDS(50,2),KTYPE(50) / 1HR, 1HO, 4 /
      DATA  ICMNDS(51,1),ICMNDS(51,2),KTYPE(51) / 1HR, 1HP, 2 /
      DATA  ICMNDS(52,1),ICMNDS(52,2),KTYPE(52) / 1HR, 1HS, 6 /
      DATA  ICMNDS(53,1),ICMNDS(53,2),KTYPE(53) / 1HR, 1HW, 2 /
      DATA  ICMNDS(54,1),ICMNDS(54,2),KTYPE(54) / 1HS, 1HE, 6 /
      DATA  ICMNDS(55,1),ICMNDS(55,2),KTYPE(55) / 1HS, 1HH, 2 /
      DATA  ICMNDS(56,1),ICMNDS(56,2),KTYPE(56) / 1HS, 1HT, 6 /
      DATA  ICMNDS(57,1),ICMNDS(57,2),KTYPE(57) / 1HT, 1HC, 2 /
      DATA  ICMNDS(58,1),ICMNDS(58,2),KTYPE(58) / 1HT, 1HN, 6 /
      DATA  ICMNDS(59,1),ICMNDS(59,2),KTYPE(59) / 1HT, 1HY, 7 /
      DATA  ICMNDS(60,1),ICMNDS(60,2),KTYPE(60) / 1HU, 1HN, 6 /
      DATA  ICMNDS(61,1),ICMNDS(61,2),KTYPE(61) / 1HU, 1HS, 6 /
      DATA  ICMNDS(62,1),ICMNDS(62,2),KTYPE(62) / 1HW, 1HA, 6 /
      DATA  ICMNDS(63,1),ICMNDS(63,2),KTYPE(63) / 1HZ, 1HO, 2 /
C
C
      MHELP  = 0
      IPROMT = 1
      JP = LINES-IPRMPT
      JPROMT = JP - 1
      IF ( .NOT.LSCRN ) GO TO 100
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
  100 CONTINUE
      NCMND = NCMND + 1
      WRITE (OUTPUT,60000) NCMND
      IF (LCHN.NE.0) WRITE (LCHN,60000) NCMND
      IF (LSCRN) CALL PCURSR(OUTPUT,11,JP)
  200 CONTINUE
      READ (INPUTD,65000) CHAR1,CHAR2
      IF (CHAR1.EQ.PLS.OR.CHAR2.EQ.PLS) GO TO 200
      IF (LCHN.NE.0) WRITE (LCHN,10000) CHAR1,CHAR2
      CALL LCUC(CHAR1)
      CALL LCUC(CHAR2)
C
C CHECK FOR QUESTION MARKS
C
      IF (CHAR1.NE.IQ.AND.CHAR2.NE.IQ) GO TO 400
      IF (.NOT.LSCRN) GO TO 300
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
  300 CONTINUE
      WRITE (OUTPUT,15000)
      IF (LSCRN) CALL PCURSR(OUTPUT,72,JP)
      IF (LCHN.NE.0) WRITE (LCHN,15000)
      GO TO 200
  400 CONTINUE
C
C  RECOGNIZE THE COMMAND BY MATCHING CHAR1 AND CHAR2 TO THE ICMNDS ARRAY
C
      MODE = 6
           DO 500 I = 1,JHELP3
           IF ( .NOT.(CHAR1.EQ.ICMNDS(I,1).AND.CHAR2.EQ.ICMNDS(I,2)) )
     X          GO TO 500
           ICOM = I
           MODE = KTYPE(I)
           GO TO 700
  500      CONTINUE
C
C  COMMAND NOT RECOGNIZED - OUTPUT ERROR MESSAGE AND TRY AGAIN
C
      IF (.NOT.LSCRN) GO TO 600
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
  600 CONTINUE
      WRITE (OUTPUT,75000) CHAR1,CHAR2
      IF (LSCRN) CALL PCURSR(OUTPUT,59,JP)
      IF (LCHN.NE.0) WRITE (LCHN,75000) CHAR1,CHAR2
      GO TO 200
C
C  IF PREVIOUS COMMAND WAS HE (I.E.DETAILED HELP COMMAND) THEN SET IARG
C   TO THE JUST RECOGNIZED COMMAND, AND RETURN.
C
  700 CONTINUE
      IF ( MHELP.NE.1 ) GO TO 800
      IARG = ICOM
      ICOM = 26
      RETURN
C
C  NOW THAT THE COMMAND IS RECOGNIZED, PROCEED TO THE NEXT STAGE
C   WHICH DEPENDS ON THE MODE OF THE COMMAND. (SEE EXPLANATION AT TOP)
C
  800 CONTINUE
      IF (MODE.EQ.1.OR.MODE.EQ.6) GO TO 1000
      IF (.NOT.LSCRN) GO TO 900
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
  900 CONTINUE
      WRITE (OUTPUT,70000) (IHELP(J,ICOM),J=1,72)
      IF (LCHN.NE.0) WRITE (LCHN,70000) (IHELP(J,ICOM),J=1,72)
 1000 CONTINUE
      GO TO (1100,1300,1600,1900,2200,2900,2700),MODE
C
C  PLACE IN HELP MODE
C
 1100 MHELP = 1
      IF (.NOT.LSCRN) GO TO 1200
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
 1200 CONTINUE
      WRITE (OUTPUT,85000)
      IF (LSCRN) CALL PCURSR(OUTPUT,42,JP)
      IF (LCHN.NE.0) WRITE (LCHN,85000)
      GO TO 200
C
C  INPUT SINGLE INTEGER ARGUMENT
C
 1300 CONTINUE
 1400 CALL SIREAD(INPUTD,IARG,ERR)
      IF ( ERR ) GO TO 2900
      IF ( .NOT.LSCRN ) GO TO 1500
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
 1500 WRITE (OUTPUT,80000)
      IF (LCHN.NE.0) WRITE (LCHN,80000)
      GO TO 1400
C
C  INPUT SINGLE DOUBLE PRECISION ARGUMENT
C
 1600 CONTINUE
 1700 CONTINUE
      CALL SRREAD(INPUTD,DARG,ERR)
      IF ( ERR ) GO TO 2900
      IF ( .NOT.LSCRN ) GO TO 1800
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
 1800 WRITE (OUTPUT,80000)
      IF (LCHN.NE.0) WRITE (LCHN,80000)
      GO TO 1700
C
C  INPUT DOUBLE PRECISION VECTOR
C
 1900 CONTINUE
 2000 CONTINUE
      CALL SVREAD(INPUTD,NLINES,IOPDM(2),V1,ERR)
      IF ( NLINES.GT.1 ) LSCRN = .FALSE.
      IF ( ERR ) GO TO 2900
      IF ( .NOT.LSCRN ) GO TO 2100
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
 2100 WRITE (OUTPUT,80000)
      IF (LCHN.NE.0) WRITE (LCHN,80000)
      GO TO 2000
C
C  INPUT TWO DOUBLE PRECISION VECTORS
C
 2200 CONTINUE
 2300 CONTINUE
      CALL SVREAD(INPUTD,NLINES,IOPDM(2),V1,ERR)
      IF ( NLINES.GT.1 ) LSCRN = .FALSE.
      IF ( ERR ) GO TO 2500
      IF ( .NOT.LSCRN ) GO TO 2400
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
 2400 WRITE (OUTPUT,80000)
      IF (LCHN.NE.0) WRITE (LCHN,80000)
      GO TO 2300
 2500 CALL SVREAD(INPUTD,NLINES,IOPDM(2),V2,ERR)
      IF ( NLINES.GT.1 ) LSCRN = .FALSE.
      IF ( ERR ) GO TO 2900
      IF ( .NOT.LSCRN ) GO TO 2600
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
 2600 WRITE (OUTPUT,80000)
      IF (LCHN.NE.0) WRITE (LCHN,80000)
      GO TO 2500
C
C  READ 2 INTEGER ARGUMENTS
C
 2700 CALL DIREAD(INPUTD,IARG,IARGP,ERR)
      IF ( ERR ) GO TO 2900
      IF ( .NOT.LSCRN ) GO TO 2800
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
 2800 WRITE (OUTPUT,80000)
      IF (LCHN.NE.0) WRITE (LCHN,80000)
      GO TO 1400
C
C  NO ARGUMENTS ARE NECESSARY
C
 2900 CONTINUE
      IF (LCHN.EQ.0) GO TO 3000
      DMNSN = IOPDM(2)
      IF (KTYPE(ICOM).EQ.1) WRITE (LCHN,20000) CHAR1,CHAR2
      IF (KTYPE(ICOM).EQ.2) WRITE (LCHN,25000) CHAR1,CHAR2,IARG
      IF (KTYPE(ICOM).EQ.3) WRITE (LCHN,30000) CHAR1,CHAR2,DARG
      IF (KTYPE(ICOM).EQ.4) WRITE (LCHN,35000) CHAR1,CHAR2,(V1(I),I=1,
     X     DMNSN)
      IF (KTYPE(ICOM).EQ.5) WRITE (LCHN,40000) CHAR1,CHAR2,(V1(I),I=1,
     X     DMNSN)
      IF (KTYPE(ICOM).EQ.5) WRITE (LCHN,45000) CHAR1,CHAR2,(V2(I),I=1,
     X     DMNSN)
      IF (KTYPE(ICOM).EQ.6) WRITE (LCHN,50000) CHAR1,CHAR2
      IF (KTYPE(ICOM).EQ.7) WRITE (LCHN,55000) CHAR1,CHAR2,IARG,IARGP
 3000 CONTINUE
      RETURN
C
C  FORMAT STATEMENTS
C
     X (73H Type command name, LI for list of commands, HS for summary o
     Xf  commands )
     Xmmand:)
      END
      SUBROUTINE LCUC(N)
C CONVERT A LOWER CASE LETTER STORED IN N INTO AN UPPER CASE LETTER.
C IF THE COMPUTING INSTALLATION DOES NOT SUPPORT LOWER CASE CHARACTERS
C THEN THIS ROUTINE SHOULD BE REPLACED BY A DUMMY ROUTINE
C
C SEQUENCE OF LETTER CHECKING IS DETERMINED BY FREQUENCIY WITH WHICH
C LETTERS OCCUR IN THE MICROSCOPE CODE.  THIS HELPS EFFICIENCY IF LCUC
C IS USED FOR PROCESSING PARTS OF THE CODE.
      INTEGER             LC(26),      UC(26)
      INTEGER             I,           N,           LBLNK
      DATA UC(1),UC(2),UC(3),UC(4),UC(5),UC(6),UC(7),UC(8),UC(9),UC(10)
     X    /  1HO,  1HI,  1HE,  1HT,  1HN,  1HR,  1HC,  1HP,  1HD,   1HL/
      DATA UC(11),UC(12),UC(13),UC(14),UC(15),UC(16),UC(17),UC(18)
     X    /   1HS,   1HA,   1HM,   1HU,   1HH,   1HF,   1HG,   1HB/
      DATA UC(19),UC(20),UC(21),UC(22),UC(23),UC(24),UC(25),UC(26)
     X    /   1HW,   1HX,   1HY,   1HV,   1HK,   1HJ,   1HQ,   1HZ/
      DATA LC(1),LC(2),LC(3),LC(4),LC(5),LC(6),LC(7),LC(8),LC(9),LC(10)
     X    /  1Ho,  1Hi,  1He,  1Ht,  1Hn,  1Hr,  1Hc,  1Hp,  1Hd,   1Hl/
      DATA LC(11),LC(12),LC(13),LC(14),LC(15),LC(16),LC(17),LC(18)
     X    /   1Hs,   1Ha,   1Hm,   1Hu,   1Hh,   1Hf,   1Hg,   1Hb/
      DATA LC(19),LC(20),LC(21),LC(22),LC(23),LC(24),LC(25),LC(26)
     X    /   1Hw,   1Hx,   1Hy,   1Hv,   1Hk,   1Hj,   1Hq,   1Hz/
C FIRST CHECK FOR A BLANK - THE MOST FREQUENTLY OCCURING CASE
      IF (N.EQ.LBLNK) RETURN
           DO 100 I = 1,26
           IF (N.NE.LC(I).AND.N.NE.UC(I)) GO TO 100
           N = UC(I)
           RETURN
  100      CONTINUE
      RETURN
      END
      SUBROUTINE SDDATA(DEVICE,MODE,NCALLS,LGO)
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C  ROUTINE:  SDDATA
C  PURPOSE:  TO DISPLAY THE NUMERICAL DATA CORRESPONDING TO THE PLOTTED
C             DATA.  THE ROUTINE HAS TWO MODES:
C                  MODE = 1 :  SCROLLING MODE
C                  MODE = 2 :  GRAPHICS MODE, IN WHICH THE SCREEN IS
C                               CLEARED BELOW THE PLOT AND THE DATA
C                               IS THEN DISPLAYED IN THE CLEARED REGION
C
      INTEGER             MIN0
      INTEGER             NF,          IEQ
      DOUBLE PRECISION    H,           V(3),        SW,          DNH
      DOUBLE PRECISION    DSH,         DNW,         DMNMX(2,3)
      INTEGER             I,           J,           K,           KP
      INTEGER             MDF(3),      NDF(7),      IEND,        JEND
      INTEGER             MODE,        IBEG,        DEVICE,      NCALLS
      INTEGER             NDER,        NCOUNT
      LOGICAL             LGO
      DOUBLE PRECISION    CBDSW,       CBD,         CBDU
      INTEGER             ICBD
      LOGICAL             LCBD
      COMMON / CB     /   CBDSW,       CBD(3),      CBDU(3),     ICBD
      COMMON / CB     /   LCBD
      INTEGER             INPUTD,      GRAPHD,      HELPD,       RECORD
      INTEGER             RSTRTD
      COMMON / IO     /   INPUTD,      GRAPHD,      HELPD,       RECORD
      COMMON / IO     /   RSTRTD
      INTEGER             LCHN
      COMMON / LOG    /   LCHN
      DOUBLE PRECISION    XS,          FS,          DF,          DFMNMX
      COMMON / FUNCOM /   XS(5377),    FS(5377),    DF(135,7)
      COMMON / FUNCOM /   DFMNMX(2,7)
      INTEGER             PLOAD,       DLOAD,       CLOAD
      COMMON / LOADIO /   PLOAD,       DLOAD,       CLOAD
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      DOUBLE PRECISION    ROPDI,       ROPPNT,      ROPDR1,      ROPDR2
      DOUBLE PRECISION    ROPSTS,      ROPSTW,      ROPUDI
      INTEGER             NH,          NW,          ILEFT,       IRIGHT
      INTEGER             IOPDM,       IOPSH,       IOPSS,       IOPWN
      INTEGER             DMNSN
      LOGICAL             OPDC,        OPDS,        OPDX,        OPCMP
      LOGICAL             OPSPL,       OPDF1,       OPDF2
      COMMON / OPTION /   ROPDI(3,2),  ROPPNT(3,2), ROPDR1(3,2)
      COMMON / OPTION /   ROPDR2(3,2), ROPSTS(2),   ROPSTW(2)
      COMMON / OPTION /   ROPUDI(3,2), NH(2),       NW(2)
      COMMON / OPTION /   ILEFT(2),    IRIGHT(2),   IOPDM(2)
      COMMON / OPTION /   IOPSH(2),    IOPSS(2),    IOPWN(2),    OPDC(2)
      COMMON / OPTION /   OPDS(2),     OPDX(2),     OPCMP(2)
      COMMON / OPTION /   OPSPL(2),    OPDF1(7,2),  OPDF2(7,2)
      LOGICAL             NORMAL
      COMMON / NRMLZE /   NORMAL
      INTEGER             ILPUSR,      IDSUSR
      COMMON / ROOM   /   ILPUSR,      IDSUSR
      EQUIVALENCE (DMNSN,IOPDM(2))
      DATA NF /1HF/, IEQ /1H=/
C
C  IF MODE = 2, CLEAR THE SCREEN BELOW PLOTTING AREA AND DISPLAY DATA
C
      IF ( MODE.EQ.1 ) GO TO 100
      I = 1
      J = LINES-IDSPLA-1
      CALL CLSCRN(DEVICE,I,J)
      CALL PCURSR(DEVICE,I,J)
  100 CONTINUE
C
C CHECK IF THERE IS ROOM TO SEPARATE GRAPHICAL AND NUMERICAL OUTPUT
C
      NCOUNT = 0
           DO 200 I = 1,7
           IF (OPDF1(I,2)) NCOUNT = NCOUNT + 1
  200      CONTINUE
      IF (NCOUNT.GT.6.OR.(NCOUNT.GT.3.AND.ICBD.NE.0.AND.ILP.EQ.ILPUSR))
     X     GO TO 300
      WRITE (DEVICE,80000) (IEQ,I=1,WIDTH)
  300 CONTINUE
C
C NEXT, DISPLAY CROSS DIRECTION DATA IF RELEVANT
C
      IF (ICBD.EQ.0) GO TO 400
      IF (DMNSN.EQ.1) WRITE (DEVICE,30000) ICBD,CBDU(1),CBDSW
      IF (DMNSN.EQ.2) WRITE (DEVICE,45000) ICBD,CBDU(1),CBDU(2),CBDSW
      IF (DMNSN.EQ.3) WRITE (DEVICE,60000) ICBD,CBDU(1),CBDU(2),CBDU(3),
     X     CBDSW
  400 CONTINUE
      DNH  = NH(2)
      DNW  = NW(2)
      DSH  = IOPSH(2)
      H    = ROPSTS(2)*DNH/8.0D0
      SW   = ROPSTS(2)*DNW/8.0D0
           DO 500 I = 1,3
           V(I) = ROPPNT(I,2)+DSH*H*ROPUDI(I,2)
  500      CONTINUE
      GO TO (600,700,800),DMNSN
  600 WRITE (DEVICE,35000) V(1),H
      WRITE (DEVICE,40000) ROPDI(1,2),SW
      GO TO 900
  700 WRITE (DEVICE,50000) V(1),V(2),H
      WRITE (DEVICE,55000) (ROPDI(I,2),I=1,2),SW
      GO TO 900
  800 WRITE (DEVICE,65000) V(1),V(2),V(3),H
      WRITE (DEVICE,70000) (ROPDI(I,2),I=1,3),SW
  900 CONTINUE
C
C  NEXT, DISPLAY THE MINIMUM/MAXIMUM'S OF THE PLOTTED DERIVATIVES
C
      NDER = 0
           DO 1000 I = 1,7
           IF ( .NOT.OPDF1(I,2) ) GO TO 1000
           NDER      = NDER+1
           NDF(NDER) = I-1
 1000      CONTINUE
      IF ( NDER.EQ.0 ) GO TO 1300
           DO 1200 I = 1,3
           IBEG      = (I-1)*3+1
           IEND      = IBEG+2
           IEND      = MIN0(NDER,IEND)
           IF ( IEND.LT.IBEG ) GO TO 1300
           JEND      = IEND - IBEG + 1
                DO 1100 J = 1,JEND
                K         = IBEG+J-1
                KP        = NDF(K)+1
                MDF(J)    = NDF(K)
                DMNMX(1,J)= DFMNMX(1,KP)
                DMNMX(2,J)= DFMNMX(2,KP)
 1100           CONTINUE
           IEND      = IEND-IBEG+1
           WRITE (DEVICE,75000) (NF,MDF(J),(DMNMX(K,J),K=1,2),J=1,IEND)
 1200      CONTINUE
C
C  DISPLAY THE NUMBER OF CALLS TO THE INTERPOLATION FUNCTION
C
 1300 CONTINUE
      IF (.NOT.NORMAL.AND.LGO) WRITE (DEVICE,10000) INPUTD,OUTPUT,
     X     GRAPHD,HELPD,RECORD,RSTRTD,LCHN,PLOAD,DLOAD,CLOAD,NCALLS
      IF (NORMAL.AND.LGO) WRITE (DEVICE,15000) INPUTD,OUTPUT,GRAPHD,
     X     HELPD,RECORD,RSTRTD,LCHN,PLOAD,DLOAD,CLOAD,NCALLS
      IF (.NOT.NORMAL.AND..NOT.LGO) WRITE (DEVICE,20000) INPUTD,OUTPUT,
     X     GRAPHD,HELPD,RECORD,RSTRTD,LCHN,PLOAD,DLOAD,CLOAD,NCALLS
      IF (NORMAL.AND..NOT.LGO) WRITE (DEVICE,25000) INPUTD,OUTPUT,
     X     GRAPHD,HELPD,RECORD,RSTRTD,LCHN,PLOAD,DLOAD,CLOAD,NCALLS
      RETURN
C
C  FORMAT STATEMENTS
C
     X8H) ch  = ,1PD12.4)
     X              7H  s  = ,1PD12.4)
     X              7H  h  = ,1PD12.4)
     X8H) ch  = ,1PD12.4)
     X              7H  s  = ,1PD12.4)
     X              7H  h  = ,1PD12.4)
      END
      SUBROUTINE SUBHE(ITYPE,ICOM,MODE)
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C  ROUTINE:  SUBHE
C  PURPOSE:  TO OUTPUT HELP INFORMATION.  THERE ARE TWO MODES:
C              (1)  OUTPUT THE LIST OF COMMANDS AND BRIEF DESCRIPTIONS
C              (2)  OUTPUT A DETAILED DESCRIPTION OF THE ICOM'TH COMMAND
C                    ALONG WITH THE VALUES OF THE CORRESPONDING
C                    PARAMETERS
C
      INTEGER             ISTOP
      DOUBLE PRECISION    DH,          ANW2
      INTEGER             I,           J,           L3,          IM
      INTEGER             KW,          NH2,         NW2,         LCH
      INTEGER             ILN,         KACC,        IEND,        MODE
      INTEGER             IBEG,        IWHICH(7),   ITEMP,       ICOM
      INTEGER             IDUM,        ILINES,      ITYPE
      INTEGER             CHAR(72),    ICNT,        KCNT,        IOUT
      DOUBLE PRECISION    CBDSW,       CBD,         CBDU
      INTEGER             ICBD
      LOGICAL             LCBD
      COMMON / CB     /   CBDSW,       CBD(3),      CBDU(3),     ICBD
      COMMON / CB     /   LCBD
      INTEGER             LCHN
      COMMON / LOG    /   LCHN
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      DOUBLE PRECISION    ROPDI,       ROPPNT,      ROPDR1,      ROPDR2
      DOUBLE PRECISION    ROPSTS,      ROPSTW,      ROPUDI
      INTEGER             NH,          NW,          ILEFT,       IRIGHT
      INTEGER             IOPDM,       IOPSH,       IOPSS,       IOPWN
      INTEGER             DMNSN
      LOGICAL             OPDC,        OPDS,        OPDX,        OPCMP
      LOGICAL             OPSPL,       OPDF1,       OPDF2
      COMMON / OPTION /   ROPDI(3,2),  ROPPNT(3,2), ROPDR1(3,2)
      COMMON / OPTION /   ROPDR2(3,2), ROPSTS(2),   ROPSTW(2)
      COMMON / OPTION /   ROPUDI(3,2), NH(2),       NW(2)
      COMMON / OPTION /   ILEFT(2),    IRIGHT(2),   IOPDM(2)
      COMMON / OPTION /   IOPSH(2),    IOPSS(2),    IOPWN(2),    OPDC(2)
      COMMON / OPTION /   OPDS(2),     OPDX(2),     OPCMP(2)
      COMMON / OPTION /   OPSPL(2),    OPDF1(7,2),  OPDF2(7,2)
      LOGICAL             NORMAL
      COMMON / NRMLZE /   NORMAL
      INTEGER             HELP,        JHELP1,      JHELP2,      JHELP3
      INTEGER             JHELP,       IHELP
      COMMON / HELPER /   HELP,        JHELP1,      JHELP2,      JHELP3
      COMMON / HELPER /   JHELP(99,2), IHELP(72,99)
      INTEGER             INPUTD,      GRAPHD,      HELPD,       RECORD
      INTEGER             RSTRTD
      COMMON / IO     /   INPUTD,      GRAPHD,      HELPD,       RECORD
      COMMON / IO     /   RSTRTD
      INTEGER ITXT(72)
      EQUIVALENCE  (DMNSN,IOPDM(2))
      DATA ISTOP /1H./
C
C  SET LSCRN TO .FALSE. SIGNIFYING THAT THE GRAPH HAS BEEN OVERWRITTEN
C
      LSCRN = .FALSE.
      ITYPE = 4
C
      CALL BLSCRN(OUTPUT)
      CALL PCURSR(OUTPUT,1,1)
      GO TO (100,400),MODE
C
C  MODE 1:  OUTPUT THE LIST OF COMMANDS AND THEIR BRIEF DESCRIPTIONS
C
  100 CONTINUE
      CALL POS(HELPD,6)
      L3 = LINES - 3
      ICNT = JHELP1
      ILN = 0
  200 CONTINUE
      ILINES = ICNT
      IF (ILINES.GT.L3) ILINES = L3
      ICNT = ICNT - ILINES
           DO 300 I = 1,ILINES
           ILN = ILN+1
           READ (HELPD,44000) (ITXT(J),J=1,72)
           WRITE (OUTPUT,46000) (ITXT(J),J=1,72)
  300      CONTINUE
      IF (ICNT.EQ.0) GO TO 2700
      WRITE (OUTPUT,48000)
      READ (INPUTD,50000) IDUM
      IF (IDUM.EQ.ISTOP) GO TO 2700
      CALL PCURSR(OUTPUT,1,L3)
      GO TO 200
C
C  MODE 2:  DETAILED DESCRIPTION OF THE ICOM'TH COMMAND
C
  400 CONTINUE
C
C  SET UP A LOOP FOR OUTPUTING INFORMATION - ONCE IF NO LOGGING IS
C   REQUIRED, TWICE OTHERWISE
C
           DO 2600 ICNT = 1,2
           IF (ICNT.EQ.1) IOUT = OUTPUT
           IF (ICNT.EQ.2.AND.LCHN.EQ.0) GO TO 2600
           IF (ICNT.EQ.2) IOUT = LCHN
           IBEG   = JHELP(ICOM,1)
           IEND   = JHELP(ICOM,2)
           NL = 5+IBEG
           CALL POS(HELPD,NL)
                DO 500 I = IBEG,IEND
                READ (HELPD,44000) (ITXT(J),J=1,72)
                WRITE (OUTPUT,46000) (ITXT(J),J=1,72)
  500           CONTINUE
           DH     = NH(2)
           ANW2   = NW(2)
           DH     = ANW2*ROPSTS(2)/8.0D0
           WRITE (IOUT,52000)
           GO TO (600,2200,2200,2200,2600,2200,2200,2200,1000,1800,1800,
     X          1800,1100,1200,2100,1500,2100,1600,1700,1200,2600,1800,
     X          2600,2600,2100,2600,2600,1800,2100,1900,2000,2200,1800,
     X          2600,2400,2000,2100,2600,2500,2600,2000,2000,2000,2600,
     X          2600,2600,2600,2600,2600,1800,2600,2600,2600,2600,2000,
     X          2600,2600,2600,2600,2600,2600,2600,1000),ICOM
  600      CONTINUE
C HELP FOR THE ACCENT COMMAND
           KACC = 0
                DO 700 I = 1,7
                IF (OPDF2(I,2)) KACC = KACC+1
  700           CONTINUE
           IF (KACC.GT.0) GO TO 800
           WRITE (IOUT,10000)
           GO TO 2600
  800      CONTINUE
                DO 900 I = 1,7
                IM = I-1
                IF (OPDF2(I,2)) WRITE (IOUT,12000) IM
  900           CONTINUE
           IF (KACC.GT.1) WRITE (IOUT,14000)
           GO TO 2600
 1000      CONTINUE
C HELP FOR THE CWINDOW COMMAND
           NW2 = 2*NW(2)
           NH2 = NH(2)
           KW = NW2/NH2
           IF (KW*NH2.EQ.NW2) WRITE (IOUT,16000) KW
           IF (KW*NH2.NE.NW2) WRITE (IOUT,18000) NW2,NH2
           GO TO 2600
 1100      CONTINUE
C Help for the DCENTER command
           IF (OPDC(2)) WRITE (IOUT,20000)
           IF (.NOT.OPDC(2)) WRITE (IOUT,22000)
           GO TO 2600
 1200      CONTINUE
C INDICATE WHICH GRAPHS ARE BEING DRAWN (ACCORDING TO OPDF1)
           KCNT = 0
                DO 1300 I = 1,7
                IF (.NOT.OPDF1(I,2)) GO TO 1300
                KCNT = KCNT+1
                IWHICH(KCNT) = I-1
 1300           CONTINUE
           IF (KCNT.GT.0) GO TO 1400
           WRITE (IOUT,24000)
           GO TO 2600
 1400      CONTINUE
           WRITE (IOUT,26000) (IWHICH(J),J=1,KCNT)
           GO TO 2600
 1500      CONTINUE
C WRITE THE CURRENT DIMENSION
           WRITE (IOUT,54000) IOPDM(2)
           GO TO 2600
 1600      CONTINUE
C INDICATE WHETHER A SCALE IS BEING DRAWN
           IF (OPDS(2)) WRITE (IOUT,30000)
           IF (.NOT.OPDS(2)) WRITE (IOUT,28000)
           GO TO 2600
 1700      CONTINUE
C INDICATE WHETHER A HORIZONTAL AXIS IS BEING DRAWN
           IF (OPDX(2)) WRITE (IOUT,32000)
           IF (.NOT.OPDX(2)) WRITE (IOUT,34000)
           GO TO 2600
 1800      CONTINUE
C DESCRIBE THE CURRENT DIRECTION OF INVESTIGATION
           WRITE (IOUT,58000) (ROPDI(I,2),I=1,DMNSN)
           GO TO 2600
 1900      CONTINUE
C give help for IINTVL
           CONTINUE
           WRITE (IOUT,36000) (ROPDR1(I,2),I=1,DMNSN)
           WRITE (IOUT,38000) (ROPDR2(I,2),I=1,DMNSN)
           GO TO 2600
 2000      CONTINUE
C Give the curren point of examination
           WRITE (IOUT,60000) (ROPPNT(I,2),I=1,DMNSN)
           GO TO 2600
 2100      CONTINUE
C Give the current value of h
           WRITE (IOUT,56000) DH
           GO TO 2600
 2200      CONTINUE
           IF (ICBD.GT.0) GO TO 2300
           WRITE (IOUT,62000)
           GO TO 2600
 2300      CONTINUE
           WRITE (IOUT,64000) ICBD,(CBDU(J),J=1,DMNSN)
           WRITE (IOUT,66000) CBDSW
           GO TO 2600
 2400      CONTINUE
           IF (LCHN.EQ.0) WRITE (IOUT,68000)
           IF (LCHN.NE.0) WRITE (IOUT,70000) LCH
           GO TO 2600
 2500      CONTINUE
           IF (NORMAL) WRITE (IOUT,40000)
           IF (.NOT.NORMAL) WRITE (IOUT,42000)
 2600      CONTINUE
 2700 CONTINUE
      RETURN
C
C  FORMAT STATEMENTS
C
     X ,18H being accentuated)
     X  D12.4)
     X16H - direction is:/3D16.6)
      END
      SUBROUTINE SUBLI(ITYPE)
      INTEGER             I,           J,           ITYPE
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      INTEGER             HELP,        JHELP1,      JHELP2,      JHELP3
      INTEGER             JHELP,       IHELP
      COMMON / HELPER /   HELP,        JHELP1,      JHELP2,      JHELP3
      COMMON / HELPER /   JHELP(99,2), IHELP(72,99)
      ITYPE = 4
      LSCRN = .FALSE.
      WRITE (OUTPUT,10000) JHELP3
      WRITE (OUTPUT,20000) ((IHELP(I,J),I=1,7),J=1,JHELP3)
      WRITE (OUTPUT,30000)
      RETURN
      END
      SUBROUTINE SUBNE(ITYPE)
C PRINT ANY NEWS THAT MAY BE AVAILABLE
      LOGICAL OK
      INTEGER             HELP,        JHELP1,      JHELP2,      JHELP3
      INTEGER             JHELP,       IHELP
      COMMON / HELPER /   HELP,        JHELP1,      JHELP2,      JHELP3
      COMMON / HELPER /   JHELP(99,2), IHELP(72,99)
      INTEGER             ISTOP
      INTEGER             I,           J,           L3,          ILN
      INTEGER             IDUM,        ILINES,      ITYPE,       ICNT
      INTEGER             INPUTD,      GRAPHD,      HELPD,       RECORD
      INTEGER             RSTRTD
      COMMON / IO     /   INPUTD,      GRAPHD,      HELPD,       RECORD
      COMMON / IO     /   RSTRTD
      INTEGER             LCHN
      COMMON / LOG    /   LCHN
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      DOUBLE PRECISION    ROPDI,       ROPPNT,      ROPDR1,      ROPDR2
      DOUBLE PRECISION    ROPSTS,      ROPSTW,      ROPUDI
      INTEGER             NH,          NW,          ILEFT,       IRIGHT
      INTEGER             IOPDM,       IOPSH,       IOPSS,       IOPWN
      LOGICAL             OPDC,        OPDS,        OPDX,        OPCMP
      LOGICAL             OPSPL,       OPDF1,       OPDF2
      INTEGER             DMNSN
      COMMON / OPTION /   ROPDI(3,2),  ROPPNT(3,2), ROPDR1(3,2)
      COMMON / OPTION /   ROPDR2(3,2), ROPSTS(2),   ROPSTW(2)
      COMMON / OPTION /   ROPUDI(3,2), NH(2),       NW(2)
      COMMON / OPTION /   ILEFT(2),    IRIGHT(2),   IOPDM(2)
      COMMON / OPTION /   IOPSH(2),    IOPSS(2),    IOPWN(2),    OPDC(2)
      COMMON / OPTION /   OPDS(2),     OPDX(2),     OPCMP(2)
      COMMON / OPTION /   OPSPL(2),    OPDF1(7,2),  OPDF2(7,2)
      INTEGER ITXT(72)
      EQUIVALENCE  (DMNSN,IOPDM(2))
      DATA ISTOP /1H./
C
C  SET LSCRN TO .FALSE. SIGNIFYING THAT THE GRAPH HAS BEEN OVERWRITTEN
C
      LSCRN = .FALSE.
      ITYPE = 4
      CONTINUE
      CALL BLSCRN(OUTPUT)
      CALL PCURSR(OUTPUT,1,1)
      NL = 6+JHELP1+JHELP2+JHELP3
      CALL POS(HELPD,NL)
      CALL SIREAD(HELPD,NNEWS,OK)
      IF (OK) GO TO 100
      WRITE (OUTPUT,20000)
      READ (INPUTD,10000) IDMY
      GO TO 400
  100 CONTINUE
      L3 = LINES - 3
      ICNT = NNEWS
      ILN = 0
  200 CONTINUE
      ILINES = ICNT
      IF (ILINES.GT.L3) ILINES = L3
      ICNT = ICNT - ILINES
           DO 300 I = 1,ILINES
           ILN = ILN+1
           READ (HELPD,30000) (ITXT(J),J=1,72)
           WRITE (OUTPUT,40000) (ITXT(J),J=1,72)
  300      CONTINUE
      IF (ICNT.EQ.0) GO TO 400
      WRITE (OUTPUT,60000)
      READ (INPUTD,70000) IDUM
      IF (IDUM.EQ.ISTOP) GO TO 400
      CALL PCURSR(OUTPUT,1,L3)
      GO TO 200
  400 CONTINUE
      RETURN
C
C  FORMAT STATEMENTS
C
     X /20H type CR to continue)
      END
      SUBROUTINE SUBPA(ITYPE,ICH)
C CONTINUE PROCESSING ONLY AFTER READING ANY CHARACTER ON CHANNEL ICH
C OR ON INPUTD IF ICH = 0
      INTEGER             J,           II,          ICH,         IPROMT
      INTEGER             JPROMT,      ITYPE
      INTEGER             INPUTD,      GRAPHD,      HELPD,       RECORD
      INTEGER             RSTRTD
      COMMON / IO     /   INPUTD,      GRAPHD,      HELPD,       RECORD
      COMMON / IO     /   RSTRTD
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      II = ICH
      IF (ICH.EQ.0) II = INPUTD
      ITYPE = 4
      IPROMT = 1
      JPROMT = LINES-IPRMPT-1
      IF ( .NOT.LSCRN ) GO TO 100
      CALL CLSCRN(OUTPUT,IPROMT,JPROMT)
      CALL PCURSR(OUTPUT,IPROMT,JPROMT)
  100 WRITE (OUTPUT,10000) II
      READ (II,20000) J
      RETURN
      END
      SUBROUTINE SUBTC(ITYPE,IARG,INPUTD)
C TYPE THE VALUE OF THE IARGTH DERIVATIVE AT THE CENTER OF THE DISPLAY
      INTEGER             IARG,        IPROPT,      JPROPT,      ITYPE
      INTEGER             IDER,        ICNTR,       INPUTD
      INTEGER             LCHN
      COMMON / LOG    /   LCHN
      LOGICAL             LDF,         LPLT,        LDEF
      COMMON / LOGCOM /   LDF(7),      LPLT(7),     LDEF(5377)
      DOUBLE PRECISION    XS,          FS,          DF,          DFMNMX
      COMMON / FUNCOM /   XS(5377),    FS(5377),    DF(135,7)
      COMMON / FUNCOM /   DFMNMX(2,7)
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      ITYPE = 4
      IPROPT = 1
      JPROPT = LINES - 3
      IF (.NOT.LSCRN) GO TO 100
      CALL CLSCRN(OUTPUT,IPROPT,JPROPT)
      CALL PCURSR(OUTPUT,IPROPT,JPROPT)
  100 CONTINUE
      IF (IARG.LT.0.OR.IARG.GT.6) GO TO 200
      IDER = IARG+1
      IF (.NOT.LDF(IDER)) GO TO 200
      ICNTR = WIDTH/2+1
      WRITE (OUTPUT,10000) IARG,DF(ICNTR,IDER)
      IF (LCHN.NE.0) WRITE (LCHN,10000) IARG,DF(ICNTR,IDER)
      GO TO 300
  200 CONTINUE
      WRITE (OUTPUT,20000) IARG
      IF (LCHN.NE.0)  WRITE (LCHN,20000) IARG
  300 CONTINUE
      WRITE (OUTPUT,30000)
      JPROPT = JPROPT + 1
      IF (LSCRN) CALL PCURSR(OUTPUT,IPROPT,JPROPT)
      READ (INPUTD,40000) IPROPT
      RETURN
      END
C
      SUBROUTINE SUBTN(ITYPE,RECORD,INPUTD,OUTPUT,GRAPHD,WIDTH,LSCRN)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C  ROUTINE:  SUBTN
C  PURPOSE:  TO "TAKE NOTE".  THIS ROUTINE ALLOWS THE USER TO WRITE
C             COMMENTS ONTO THE FILE ASSIGNED TO THE DEVICE: RECORD.
C             TO END THE COMMENTS TYPE "EC" IN THE FIRST TWO COLUMNS
C             OF INPUT.
C
      INTEGER             C,           E,           BLANK
      INTEGER             I,           J,           C1,          C2
      INTEGER             WW,          NWW,         RECORD,      GRAPHD
      INTEGER             OUTPUT,      ITYPE,       CHAR(135),   WIDTH
      INTEGER             INPUTD
      LOGICAL             LSCRN
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C     COMMON BLOCK / LOG    /
C
      INTEGER             LCHN
      COMMON / LOG    /   LCHN
C
      DATA   E,C,BLANK / 1HE, 1HC, 1H  /
      IF ( OUTPUT.EQ.GRAPHD ) LSCRN = .FALSE.
      WW = WIDTH
      IF (WW.LT.80) WW = 80
      ITYPE = 4
      WRITE (OUTPUT,10000)
  100 READ (INPUTD,20000) (CHAR(I),I=1,WW)
      C1 = CHAR(1)
      C2 = CHAR(2)
      IF ( C1.EQ.E .AND. C2.EQ.C ) GO TO 400
C STRIP TRAILING BLANKS
      NWW = WW
           DO 200 I = 1,WW
           J = WW-I+1
           IF (CHAR(J).NE.BLANK) GO TO 300
           NWW = NWW-1
  200      CONTINUE
  300 CONTINUE
      WRITE (RECORD,30000) (CHAR(I),I=1,NWW)
      IF (LCHN.NE.0) WRITE (LCHN,30000) (CHAR(I),I=1,NWW)
      GO TO 100
  400 CONTINUE
      RETURN
C
C  FORMAT STATEMENTS
C
      END
      SUBROUTINE SUBTY(ITYPE,IARG,IARGP,INPUTD,GRAPHD)
C TYPE THE VALUE OF THE IARGTH DERIVATIVE AT THE IARGPTH POSITION IN THE
C DISPLAY
      INTEGER             IM(1)
      INTEGER             I,           IARG,        IARGP,       IPROPT
      INTEGER             JPROPT,      GRAPHD,      ITYPE,       IDER
      INTEGER             ICNTR,       COLUMN(57),  INPUTD
      INTEGER             LCHN
      COMMON / LOG    /   LCHN
      LOGICAL             LDF,         LPLT,        LDEF
      COMMON / LOGCOM /   LDF(7),      LPLT(7),     LDEF(5377)
      DOUBLE PRECISION    XS,          FS,          DF,          DFMNMX
      COMMON / FUNCOM /   XS(5377),    FS(5377),    DF(135,7)
      COMMON / FUNCOM /   DFMNMX(2,7)
      INTEGER             IPLOT,       ISCRN1,      ISCRN2
      REAL                SCALE
      COMMON / PLTCOM /   SCALE(7),    IPLOT(135,7),ISCRN1(135,57)
      COMMON / PLTCOM /   ISCRN2(135,57)
      INTEGER             OUTPUT,      LINES,       WIDTH,       ILP
      INTEGER             IDSPLA,      IPRMPT
      LOGICAL             LSCRN
      COMMON / SCREEN /   OUTPUT,      LINES,       WIDTH,       ILP
      COMMON / SCREEN /   IDSPLA,      IPRMPT,      LSCRN
      DATA IM(1) /1H!/
      ITYPE = 4
      IPROPT = 1
      JPROPT = LINES - 3
      IF (.NOT.LSCRN) GO TO 100
      CALL CLSCRN(OUTPUT,IPROPT,JPROPT)
      CALL PCURSR(OUTPUT,IPROPT,JPROPT)
  100 CONTINUE
      IF (IARG.LT.0.OR.IARG.GT.6) GO TO 400
      IDER = IARG+1
      IF (.NOT.LDF(IDER)) GO TO 400
      ICNTR = WIDTH/2+1
      ICNTR = ICNTR + IARGP
      IF (ICNTR.LT.0.OR.ICNTR.GT.WIDTH) GO TO 500
      WRITE (OUTPUT,10000) IARG,IARGP,DF(ICNTR,IDER)
      IF (LCHN.NE.0) WRITE (LCHN,10000) IARG,IARGP,DF(ICNTR,IDER)
      IF (.NOT.LSCRN) GO TO 600
           DO 200 I = 1,ILP
           COLUMN(I) = ISCRN2(ICNTR,I)
           CALL PLCHRS(GRAPHD,ICNTR,I,1,IM)
  200      CONTINUE
           DO 300 I = 1,ILP
           CALL PLCHRS(GRAPHD,ICNTR,I,1,COLUMN(I))
  300      CONTINUE
      GO TO 600
  400 CONTINUE
      WRITE (OUTPUT,20000) IARG
      IF (LCHN.NE.0) WRITE (LCHN,20000) IARG
      GO TO 600
  500 CONTINUE
      WRITE (OUTPUT,30000) IARGP
      IF (LCHN.NE.0) WRITE (LCHN,30000) IARGP
  600 CONTINUE
      JPROPT = JPROPT + 1
      IF (LSCRN) CALL PCURSR(OUTPUT,IPROPT,JPROPT)
      WRITE (OUTPUT,40000)
      IF (LSCRN) CALL PCURSR(OUTPUT,IPROPT,JPROPT)
      READ (INPUTD,50000) IPROPT
      RETURN
      END

.


AD:

NEW PAGES:

[ODDNUGGET]

[GOPHER]