C 
C Subroutine file 'scro' - screen output subroutines with graphics
C
C Date: 2004, June 11
C Coded by Ludek Klimes
C
C.......................................................................
C
C Description of input data:
C
C Input parameters taken from the input SEP parameter file for the
C Complete Ray Tracing program
C     SCRPLUS=integer
C     SCRANSI=integer
C     SCRWIDTH=integer
C     SCRHEIGHT=integer
C     SCRBBOX1=real, SCRBBOX2=real, SCRBBOX3=real, SCRBBOX4=real
C     SCRLINE=real
C     CRTSCRO='string'
C     CRTPAUSE=integer
C are described in file crtin.for.
C
C.......................................................................
C
C This file consists of:
C     SCROB...Block data subroutine defining auxiliary common block
C             /SCROC/ to configure the screen output.
C             SCROB
C     SCRO1...Screen output subroutine called when starting the complete
C             ray tracing program, and when starting the computation of
C             a new elementary wave.
C             SCRO1
C     SCRO2...Screen output subroutine called when starting the complete
C             tracing of a new ray.
C             SCRO2
C     SCRO3...Screen output subroutine called with constant step STORE
C             of the independent variable along the ray, and at the
C             points of intersection with interfaces either before and
C             after the transformation.
C             SCRO3
C     SCRO4...Screen output subroutine called after termination of
C             tracing the ray.
C             SCRO4
C     SCRO5...Screen output subroutine called after termination of the
C             computation of an elementary wave, and when terminating
C             the complete ray tracing program.
C             SCRO5
C     CURSOR..Character function that returns the ANSI escape sequence
C             positioning the cursor at the beginning of the given line.
C             CURSOR
C     Specification of the used CalComp graphics subroutines.
C             CalComp
C
C Attention: If setting input parameter CRTPAUSE=1,
C     subroutine SCRO5 may require an input from the keyboard
C     (external unit *) to proceed to the next elementary wave.  This
C     should be taken into account if linking 'crt.for' and wishing to
C     redirect the standard input * unit into a file.
C
C                                                  
C Brief description of the output screen:
C     The output screen is split into the left-hand column (1/4 of
C     the screen) and the right-hand column (3/4 of the screen).  The
C     left-hand column is reserved for the text output of the width of
C     20 characters and the height of 24 lines, controlled by the ANSI
C     escape sequences.  The right-hand column is reserved for the
C     graphical output.
C     The graphical output is completed by invocation of the CalComp
C     subroutines PLOTS, PLOT, and NEWPEN.  Since the CalComp plot units
C     are centimetres (maybe inches in U.S.A.), the screen is assumed to
C     have the dimensions of A4 sheet (29.7cm*21.0cm).  If the CalComp
C     subroutines you are using assume other screen dimensions, it is
C     necessary to change the values HMIN,HMAX,VMIN,VMAX,WIDTH in block
C     data SCROB below.
C Left-hand column - textual output:
C     The left-hand column contains the sequential indices of the
C     elementary wave and ray being traced, two take-off ray parameters,
C     and the indices of simple blocks, complex blocks, and surfaces
C     covering structural interfaces, at all points of incidence and
C     reflection/transmission, and at the ray endpoint.  Also the reason
C     of the termination of the computation of the ray, see
C     C.R.T.5.4,
C     is written to the screen.
C Right-hand column - graphical output:
C     The right-hand column is split into 2*2 rectangles.  The upper
C     right-hand rectangle contains the initial points of rays, the
C     upper left-hand and the two bottom rectangles contain the
C     projections of rays onto the top and the sides of the model.
C   Three graphical panels with ray projections:
C     The upper left-hand rectangle contains the projection of rays onto
C     the top horizontal side of the model volume (plane X1X2).  The
C     bottom left-hand rectangle contains the front view of rays
C     (projection of rays onto the front side X1X3 of the model volume).
C     The bottom right-hand rectangle contains the projection of rays
C     onto the right-hand vertical side X2X3 of the model volume.  The
C     rays increase their colour index by one at each point of
C     reflection or transmission.  The model side of generally different
C     dimensions and aspect ratios are scaled into the rectangles of
C     equal size. Moreover, in curvilinear coordinates the model volume
C     limited by curved coordinate surfaces is scaled into cube for the
C     purposes of the screen output.
C   Upper rightmost graphical panel:
C     The upper rightmost rectangle contains the initial points of rays.
C     The horizontal screen axis corresponds to shooting parameter A and
C     the vertical axis corresponds to shooting parameter B, see the
C     description of the input data (5) in 'rpar.for'.  In other words,
C     the bottom left-hand corner of the rectangle corresponds to the
C     ray take-off parameters PAR1L,PAR2L, the bottom right-hand corner
C     to PAR1A,PAR2A, and the upper left-hand corner to PAR1B,PAR2B.
C     The different color indices at the upper rightmost panel
C     correspond to different ray histories.
C
C Configuration of the screen output:
C     The quantities specifying the scale and other properties of the
C     simple graphic output are stored in the common block /SCROC/
C     defined in the following subroutine:
C     ------------------------------------------------------------------
C     
C
      BLOCK DATA SCROB
      INCLUDE 'scro.inc'
C     scro.inc
      END
C     ------------------------------------------------------------------
C     HMIN, HMAX... Horizontal coordinates of the vertical boundaries of
C             the plotting area in the plot coordinates.
C             The leftmost 1/4 of the screen area is reserved for the
C             text output.
C     VMIN, VMAX... Vertical coordinates of the horizontal boundaries of
C             the plotting area in the plot coordinates.
C     WIDTH...Estimated thickness of the plotted line.
C
C=======================================================================
C
C     
C
      SUBROUTINE SCRO1(ISRC,IWAVE)
      INTEGER ISRC,IWAVE
C
C This screen output subroutine is called when starting the complete ray
C tracing program, and when starting the computation of a new elementary
C wave.
C
C Input:
C     IWAVE...Zero when starting the complete ray tracing program,
C             otherwise the index of the elementary wave which will be
C             computed (i.e. the output of the subroutine CODE1 from the
C             file 'code.for').
C     ISRC... Index of the source.  The sources are indexed by positive
C             integers.
C
C No output.
C
C Common block /DCRT/ (see subroutine file 'ray.for'):
      INCLUDE 'dcrt.inc'
C     dcrt.inc
C None of the storage locations of the common block are altered.
C
C Common block /RPARD/ (defined in file 'rpar.for'):
      INCLUDE 'rpard.inc'
C     rpard.inc
C Storage locations of the common block are not altered.
C
C Common block /SCROC/:
      INCLUDE 'scro.inc'
C     scro.inc
C Storage locations H1B,H2A,H2B,V2A,V2B,V3A,V3B,JWAVE of the common
C block are defined in this subroutine.
C
C Subroutines and external functions required:
      EXTERNAL SCROB,CURSOR,RSEP3I,RSEP3R,RSEP3T,PLOTS,PLOT,NEWPEN
C     SCROB.. Block data subroutine of this file.
C     CURSOR... This file.
C     RSEP3I,RSEP3R,RSEP3T... File 'sep.for'.
C     PLOTS,PLOT,NEWPEN... CalComp graphics subroutines.
C
C Date: 2003, May 12
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER MTEXT,I
      PARAMETER (MTEXT=120)
      CHARACTER*(MTEXT) TEXT
      CHARACTER*(NSCR) CRTSCR
      REAL STREET,H1,H2,V1,V2,AUX1,AUX2
C
C     Reading the input data:
      IF(IWAVE.EQ.0) THEN
        CALL RSEP3I('SCRPLUS'  ,KPLUS,1)
        CALL RSEP3I('SCRANSI'  ,KANSI,1)
        CALL RSEP3I('SCRWIDTH' ,NWIDTH,79)
        IF(NWIDTH.LT.20) THEN
C         541
          CALL ERROR('541 in SCRO1: Screen lines shorter than 20 char.')
C         The number SCRWIDTH of characters per one line of the screen
C         output should be at least 20.  Adjust the input data.
        END IF
        CALL RSEP3I('SCRHEIGHT',NLINES,25)
        CALL RSEP3R('SCRBBOX1' ,HMIN , 2.77)
        CALL RSEP3R('SCRBBOX2' ,VMIN , 0.02)
        CALL RSEP3R('SCRBBOX3' ,HMAX ,10.98)
        CALL RSEP3R('SCRBBOX4' ,VMAX , 8.48)
        CALL RSEP3R('SCRLINE'  ,WIDTH, 0.017)
        CALL RSEP3T('CRTSCRO'  ,CRTSCR,'SW')
        CALL RSEP3I('CRTPAUSE' ,IPAUSE,0)
        IF(IPAUSE.NE.0) THEN
          IPAUSE=1
        END IF
        DO 11 I=1,NSCR
          KSCR(I)=0
   11   CONTINUE
        DO 12 I=1,NSCR
          IF(CRTSCR(I:I).EQ.'S'.OR.CRTSCR(I:I).EQ.'s') KSCR(1)=1
          IF(CRTSCR(I:I).EQ.'W'.OR.CRTSCR(I:I).EQ.'w') KSCR(2)=1
          IF(CRTSCR(I:I).EQ.'R'.OR.CRTSCR(I:I).EQ.'r') KSCR(3)=1
          IF(CRTSCR(I:I).EQ.'A'.OR.CRTSCR(I:I).EQ.'a') KSCR(4)=1
          IF(CRTSCR(I:I).EQ.'P'.OR.CRTSCR(I:I).EQ.'p') KSCR(5)=1
          IF(CRTSCR(I:I).EQ.'H'.OR.CRTSCR(I:I).EQ.'h') KSCR(6)=1
          IF(CRTSCR(I:I).EQ.'E'.OR.CRTSCR(I:I).EQ.'e') KSCR(7)=1
          IF(CRTSCR(I:I).EQ.'G'.OR.CRTSCR(I:I).EQ.'g') KSCR(8)=1
   12   CONTINUE
      END IF
C
      JWAVE=IWAVE
      JSRC=ISRC
      IF(IWAVE.EQ.0) THEN
C
C       Erasing screen:
        IF(KANSI.GE.1.OR.KPLUS.GE.3) THEN
          WRITE(TEXT,'(A)') 'CRT: Computing.'
          CALL CURSOR(-3,TEXT(1:20))
        END IF
        KSCR(NSCR)=NLINES-1
C
      ELSE
C
C       Space between frames:
        STREET=2.*WIDTH
C
C       Coefficients of the linear projections onto the screen:
        AUX1=BOUNDR(2)-BOUNDR(1)
        IF(AUX1.EQ.0.) THEN
          AUX1=1.
        END IF
        H1A=((HMAX-HMIN-STREET)/2.-3.*WIDTH)/AUX1
        H1B=HMIN+1.5*WIDTH-BOUNDR(1)*H1A
        AUX1=BOUNDR(4)-BOUNDR(3)
        IF(AUX1.EQ.0.) THEN
          AUX1=1.
        END IF
        H2A=((HMAX-HMIN-STREET)/2.-3.*WIDTH)/AUX1
        H2B=HMAX-1.5*WIDTH-BOUNDR(4)*H2A
        V2A=((VMAX-VMIN-STREET)/2.-3.*WIDTH)/AUX1
        V2B=VMAX-1.5*WIDTH-BOUNDR(4)*V2A
        AUX1=BOUNDR(6)-BOUNDR(5)
        IF(AUX1.EQ.0.) THEN
          AUX1=1.
        END IF
        V3A=((VMAX-VMIN-STREET)/2.-3.*WIDTH)/AUX1
        V3B=VMIN+1.5*WIDTH-BOUNDR(5)*V3A
C
C       Screen graphics:
        IF(KSCR(8).NE.0) THEN
C
C         Plot initialization:
          CALL PLOTS(0,0,0)
          CALL NEWPEN(1)
C
C         Plotting frames:
C         Left-hand top
          H1=HMIN+WIDTH/2.
          H2=(HMIN+HMAX-STREET-WIDTH)/2.
          V1=(VMIN+VMAX+STREET+WIDTH)/2.
          V2=VMAX-WIDTH/2.
          CALL PLOT(H1,V1,3)
          CALL PLOT(H2,V1,2)
          CALL PLOT(H2,V2,2)
          CALL PLOT(H1,V2,2)
          CALL PLOT(H1,V1,2)
C         Left-hand bottom
          V1=VMIN+WIDTH/2.
          V2=(VMIN+VMAX-STREET-WIDTH)/2.
          CALL PLOT(H1,V1,3)
          CALL PLOT(H2,V1,2)
          CALL PLOT(H2,V2,2)
          CALL PLOT(H1,V2,2)
          CALL PLOT(H1,V1,2)
C         Right-hand bottom
          H1=(HMIN+HMAX+STREET+WIDTH)/2.
          H2=HMAX-WIDTH/2.
          CALL PLOT(H1,V1,3)
          CALL PLOT(H2,V1,2)
          CALL PLOT(H2,V2,2)
          CALL PLOT(H1,V2,2)
          CALL PLOT(H1,V1,2)
C         Right-hand top
          V1=(VMIN+VMAX+STREET+WIDTH)/2.
          V2=VMAX-WIDTH/2.
          CALL NEWPEN(6)
          CALL PLOT(H1,V1,3)
          CALL PLOT(H2,V1,2)
          CALL PLOT(H2,V2,2)
          CALL PLOT(H1,V2,2)
          CALL PLOT(H1,V1,2)
C
C         Plotting receivers
          CALL NEWPEN(1)
          DO 51 I=1,NREC
            IF(ISRFX(1).EQ.-1.AND.ISRFX(2).EQ.-2) THEN
              AUX1=XREC(1,I)*H1A+H1B
              AUX2=XREC(2,I)*V2A+V2B
            ELSE IF(ISRFX(2).EQ.-1.AND.ISRFX(1).EQ.-2) THEN
              AUX1=XREC(2,I)*H1A+H1B
              AUX2=XREC(1,I)*V2A+V2B
            ELSE IF(ISRFX(1).EQ.-1.AND.ISRFX(2).EQ.-3) THEN
              AUX1=XREC(1,I)*H1A+H1B
              AUX2=XREC(2,I)*V3A+V3B
            ELSE IF(ISRFX(2).EQ.-1.AND.ISRFX(1).EQ.-3) THEN
              AUX1=XREC(2,I)*H1A+H1B
              AUX2=XREC(1,I)*V3A+V3B
            ELSE IF(ISRFX(1).EQ.-2.AND.ISRFX(2).EQ.-3) THEN
              AUX1=XREC(1,I)*H2A+H2B
              AUX2=XREC(2,I)*V3A+V3B
            ELSE IF(ISRFX(2).EQ.-2.AND.ISRFX(1).EQ.-3) THEN
              AUX1=XREC(2,I)*H2A+H2B
              AUX2=XREC(1,I)*V3A+V3B
            ELSE
              GO TO 52
            END IF
            CALL PLOT(AUX1-2.*WIDTH,AUX2-2.*WIDTH,3)
            CALL PLOT(AUX1+2.*WIDTH,AUX2-2.*WIDTH,2)
            CALL PLOT(AUX1+2.*WIDTH,AUX2+2.*WIDTH,2)
            CALL PLOT(AUX1-2.*WIDTH,AUX2+2.*WIDTH,2)
            CALL PLOT(AUX1-2.*WIDTH,AUX2-2.*WIDTH,2)
   51     CONTINUE
   52     CONTINUE
          DO 53 I=1,NREC
            IF(ISRFX(1).EQ.-1.AND.ISRFX(2).EQ.0.) THEN
              AUX1=XREC(1,I)*H1A+H1B
              CALL PLOT(AUX1,BOUNDR(3)*V2A+V2B,3)
              CALL PLOT(AUX1,BOUNDR(4)*V2A+V2B,2)
              CALL PLOT(AUX1,BOUNDR(5)*V3A+V3B,3)
              CALL PLOT(AUX1,BOUNDR(6)*V3A+V3B,2)
            ELSE IF(ISRFX(1).EQ.-2.AND.ISRFX(2).EQ.0.) THEN
              AUX1=XREC(1,I)*H2A+H2B
              AUX2=XREC(1,I)*V2A+V2B
              CALL PLOT(AUX1,BOUNDR(5)*V3A+V3B,3)
              CALL PLOT(AUX1,BOUNDR(6)*V3A+V3B,2)
              CALL PLOT(BOUNDR(1)*H1A+H1B,AUX2,3)
              CALL PLOT(BOUNDR(2)*H1A+H1B,AUX2,2)
            ELSE IF(ISRFX(1).EQ.-3.AND.ISRFX(2).EQ.0.) THEN
              AUX2=XREC(1,I)*V3A+V3B
              CALL PLOT(BOUNDR(1)*H1A+H1B,AUX2,3)
              CALL PLOT(BOUNDR(2)*H1A+H1B,AUX2,2)
              CALL PLOT(BOUNDR(3)*H2A+H2B,AUX2,3)
              CALL PLOT(BOUNDR(4)*H2A+H2B,AUX2,2)
            ELSE
              GO TO 54
            END IF
   53     CONTINUE
   54     CONTINUE
C
        END IF
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE SCRO2(IRAY)
      INTEGER IRAY
C
C This screen output subroutine is called when starting the complete
C tracing of a new ray.
C
C Input:
C     IRAY... The index of the ray which will be computed (i.e. the
C             output of the subroutine RPAR2 from the file 'rpar.for').
C
C No output.
C
C Common block /INITC/ (see subroutine file 'init.for'):
      INCLUDE 'initc.inc'
C     initc.inc
C None of the storage locations of the common block are altered.
C
C Common block /SCROC/:
      INCLUDE 'scro.inc'
C     scro.inc
C Storage locations H1OLD,H2OLD,V2OLD,V3OLD of the common block are
C defined in this subroutine.
C
C Subroutines and external functions required:
      EXTERNAL CURSOR
C     CURSOR..This file.
C
C Date: 2003, May 20
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER MTEXT,NCHAR,K1,K2,NWORD,NSPACE,N1,N2
      PARAMETER (MTEXT=120)
      CHARACTER*(MTEXT) TEXT
C
C     Writing to the screen:
      K1=1
   10 CONTINUE
C       Determining items K1 to K2 for the current output line:
        NWORD=0
        NCHAR=0
        IF(K1.LE.1.AND.KSCR(1).NE.0) THEN
          IF(NCHAR+NWORD+11.LE.NWIDTH) THEN
            NWORD=NWORD+1
            NCHAR=NCHAR+11
          ELSE
            K2=0
            GO TO 20
          END IF
        END IF
        IF(K1.LE.2.AND.KSCR(2).NE.0) THEN
          IF(NCHAR+NWORD+9.LE.NWIDTH) THEN
            NWORD=NWORD+1
            NCHAR=NCHAR+9
          ELSE
            K2=1
            GO TO 20
          END IF
        END IF
        IF(K1.LE.4.AND.KSCR(3)+KSCR(4).NE.0) THEN
          IF(NCHAR+NWORD+12*KSCR(3)+7*KSCR(4).LE.NWIDTH) THEN
            NWORD=NWORD+MAX0(KSCR(3),KSCR(4))
            NCHAR=NCHAR+12*KSCR(3)+7*KSCR(4)
          ELSE
            K2=2
            GO TO 20
          END IF
        END IF
        IF(K1.LE.5.AND.KSCR(5).NE.0) THEN
          IF(K1.EQ.5) THEN
            NWORD=1
            NCHAR=19
          ELSE
            IF(NCHAR+NWORD+35.LE.NWIDTH) THEN
              NWORD=NWORD+2
              NCHAR=NCHAR+34
            ELSE
              K2=4
              GO TO 20
            END IF
          END IF
        END IF
        K2=5
   20   CONTINUE
        IF(NWORD.GT.0) THEN
C         Writing items K1 to K2 to string TEXT(1:N2)
          N2=0
          IF(NWORD.LE.1) THEN
            NSPACE=0
          ELSE
            NSPACE=MIN0((NWIDTH-NCHAR)/(NWORD-1),8)
          END IF
          IF(K1.LE.3.AND.4.LE.K2) THEN
            IF(KSCR(3).NE.0) THEN
              IF(KSCR(4).NE.0) THEN
                N1=N2+1
                N2=N2+11
                WRITE(TEXT(N1:N2),'(A,I4)') 'Tracing ray'
              ELSE
                N1=N2+1
                N2=N2+4
                WRITE(TEXT(N1:N2),'(A,I4)') 'Ray:'
              END IF
              N1=N2+1
              N2=N2+8+NSPACE
              WRITE(TEXT(N1:N2),'(I8)') IRAY
            ELSE
              IF(KSCR(4).NE.0) THEN
                N1=N2+1
                N2=N2+7+NSPACE
                WRITE(TEXT(N1:N2),'(A,I4)') 'Tracing'
              END IF
            END IF
          END IF
          IF(K1.LE.5.AND.5.LE.K2.AND.KSCR(5).NE.0) THEN
            IF(K1.EQ.5) THEN
              N1=1
              N2=19
              WRITE(TEXT(N1:N2),'(A,F14.6)') 'Par1:',YI(20)
              CALL CURSOR(0,TEXT(1:N2))
              KSCR(NSCR)=KSCR(NSCR)-1
              WRITE(TEXT(N1:N2),'(A,F14.6)') 'Par2:',YI(21)
              N2=19+NSPACE
            ELSE
              N1=N2+1
              N2=N2+17+NSPACE
              WRITE(TEXT(N1:N2),'(A,F12.6)') 'Par1:',YI(20)
              N1=N2+1
              N2=N2+17+NSPACE
              WRITE(TEXT(N1:N2),'(A,F12.6)') 'Par2:',YI(21)
            END IF
          END IF
          IF(IRAY.EQ.1) THEN
            IF(K1.LE.2.AND.2.LE.K2.AND.KSCR(2).NE.0) THEN
              N1=N2+1
              N2=N2+9+NSPACE
              WRITE(TEXT(N1:N2),'(A,I4)') 'Wave:',JWAVE
            END IF
            IF(K1.LE.1.AND.1.LE.K2.AND.KSCR(1).NE.0) THEN
              N1=N2+1
              N2=N2+11+NSPACE
              WRITE(TEXT(N1:N2),'(A,I4)') 'Source:',JSRC
            END IF
          END IF
          N2=N2-NSPACE
          IF(N2.GT.NWIDTH) THEN
C           542
            CALL ERROR('542 in SCRO1: Too long output line')
C           This error should not appear.  Contact the authors.
          END IF
          IF(K1.GT.2.AND.N2.LE.0) THEN
C           544
            CALL ERROR('544 in SCRO1: Too long output line')
C           This error should not appear.  Contact the authors.
          END IF
          IF(IRAY.LE.1.AND.N2.LE.0) THEN
C           543
            CALL ERROR('543 in SCRO1: Too long output line')
C           This error should not appear.  Contact the authors.
          END IF
          IF(IRAY.LE.1.AND.K1.LE.4.AND.4.LE.K2) THEN
            KSCR(NSCR-1)=KSCR(NSCR)
          END IF
C         Writing string TEXT(1:N2) to the screen
          IF(IRAY.LE.1.AND.K1.LE.1) THEN
            IF(N2.LT.15) THEN
              TEXT(N2+1:15)=' '
              N2=15
            END IF
            CALL CURSOR(-1,TEXT(1:N2))
          ELSE IF(IRAY.GT.1.AND.K1.LE.3) THEN
            IF(N2.GT.0) THEN
              IF(K2.LE.3) THEN
                IF(KSCR(NSCR-1)+1.EQ.KSCR(NSCR)) THEN
                  CALL CURSOR(-1,TEXT(1:N2))
                ELSE
                  CALL CURSOR(NLINES-KSCR(NSCR-1)-1,TEXT(1:N2))
                END IF
                KSCR(NSCR)=KSCR(NSCR-1)+1
              ELSE
                IF(KSCR(NSCR-1).EQ.KSCR(NSCR)) THEN
                  CALL CURSOR(-1,TEXT(1:N2))
                ELSE
                  CALL CURSOR(NLINES-KSCR(NSCR-1),TEXT(1:N2))
                END IF
                KSCR(NSCR)=KSCR(NSCR-1)
              END IF
            END IF
          ELSE
            CALL CURSOR(0,TEXT(1:N2))
            KSCR(NSCR)=KSCR(NSCR)-1
          END IF
        END IF
        K1=K2+1
      IF(K1.LE.5) GO TO 10
C
      IF(KSCR(6).NE.0) THEN
        WRITE(TEXT,'(A)')       '                    '
        CALL CURSOR(0,TEXT(1:20))
        WRITE(TEXT,'(A)')       '        ISB ICB ISRF'
        CALL CURSOR(0,TEXT(1:20))
        KSCR(NSCR)=KSCR(NSCR)-2
      END IF
C
C     Initial position for plotting the ray:
      H1OLD=YI(3)*H1A+H1B
      H2OLD=YI(4)*H2A+H2B
      V2OLD=YI(4)*V2A+V2B
      V3OLD=YI(5)*V3A+V3B
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE SCRO3(YL,Y,YY,IY)
      REAL YL(6),Y(35),YY(5)
      INTEGER IY(12)
C
C This screen output subroutine is called with constant step STORE of
C the independent variable along the ray, and at the points of
C intersection with interfaces either before and after the
C transformation.  It plots the part of the ray computed in the last
C step of the numerical integration.  It is called by the subroutine
C WRIT31.
C
C Input:
C     YL...   Array containing local quantities at the point of the ray.
C     Y...    Array containing basic quantities computed along the ray.
C     YY...   Array containing real auxiliary quantities computed along
C             the ray.
C     IY...   Array containing integer auxiliary quantities computed
C             along the ray.
C None of the input parameters are altered.
C
C No output.
C
C Common block /SCROC/:
      INCLUDE 'scro.inc'
C     scro.inc
C Storage locations H1OLD,H2OLD,V2OLD,V3OLD of the common block are
C redefined in this subroutine.
C
C Subroutines and external functions required:
      EXTERNAL CURSOR
      EXTERNAL NSRFC,PLOT,NEWPEN
      INTEGER NSRFC
C     CURSOR..This file.
C     NSRFC... File 'model.for'.
C     PLOT,NEWPEN... CalComp graphics subroutines.
C
C Date: 2003, May 12
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER MTEXT
      PARAMETER (MTEXT=120)
      CHARACTER*(MTEXT) TEXT
      REAL H1NEW,H2NEW,V2NEW,V3NEW
C
C     Writing to the screen:
      IF(KSCR(6).NE.0) THEN
        IF(IY(6).NE.0) THEN
          IF(KSCR(NSCR).GE.2+IPAUSE) THEN
            IF(IY(8).NE.0) THEN
              WRITE(TEXT,'(A,3I4)') '.......',IY(4),IY(5),IY(6)
              CALL CURSOR(0,TEXT(1:20))
            ELSE
              WRITE(TEXT,'(A,3I4)') '       ',IY(4),IY(5),IY(6)
              CALL CURSOR(0,TEXT(1:20))
            END IF
            KSCR(NSCR)=KSCR(NSCR)-1
          ELSE
            IF(IY(8).NE.0) THEN
              WRITE(TEXT,'(A,3I4)') '.......',IY(4),IY(5),IY(6)
              CALL CURSOR(-1,TEXT(1:20))
            ELSE
              WRITE(TEXT,'(A,3I4)') '       ',IY(4),IY(5),IY(6)
              CALL CURSOR(-1,TEXT(1:20))
            END IF
          END IF
        END IF
      END IF
C
C     Screen graphics:
      IF(KSCR(8).NE.0) THEN
C       Plotting the ray at the screen:
        H1NEW=Y(3)*H1A+H1B
        H2NEW=Y(4)*H2A+H2B
        V2NEW=Y(4)*V2A+V2B
        V3NEW=Y(5)*V3A+V3B
        CALL NEWPEN(IY(11)+2)
        CALL PLOT(H1OLD,V2OLD,3)
        CALL PLOT(H1NEW,V2NEW,2)
        CALL PLOT(H1OLD,V3OLD,3)
        CALL PLOT(H1NEW,V3NEW,2)
        CALL PLOT(H2OLD,V3OLD,3)
        CALL PLOT(H2NEW,V3NEW,2)
        H1OLD=H1NEW
        H2OLD=H2NEW
        V2OLD=V2NEW
        V3OLD=V3NEW
      END IF
C
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE SCRO4(IRAY,YL,Y,YY,IY,IEND,ISHEET)
C
      INTEGER IRAY,IY(12),IEND,ISHEET
      REAL YL(6),Y(35),YY(5)
C
C This screen output subroutine is called after termination of tracing
C the ray.
C
C Input:
C     IRAY... The index of the ray which has been computed (i.e. the
C             output of the subroutine RPAR2 of the file 'rpar.for').
C     YL...   Array containing local quantities at the point of the ray.
C     Y...    Array containing basic quantities computed along the ray.
C     YY...   Array containing real auxiliary quantities computed along
C             the ray.
C     IY...   Array containing integer auxiliary quantities computed
C             along the ray.
C     IEND... Reason of the termination of the computation of a ray, see
C             C.R.T.5.4.
C             See subroutine RAY in the subroutine file 'ray.for' for
C             detailed description of IEND.
C     ISHEET..Ray-history index.  The different ray histories are
C             consecutively indexed by positive integers 1,2,3,...
C             According to their appearance during ray tracing.
C             The ray histories are indexed independently within each
C             elementary wave.
C             The ray-history indices are complemented with sign:
C             positive - successful ray (crossing reference surface),
C             negative - unsuccessful ray (terminating before crossing
C             reference surface).
C
C No output.
C
C Common block /RPARD/ (defined in file 'rpar.for'):
      INCLUDE 'rpard.inc'
C     rpard.inc
C Storage locations of the common block are not altered.
C
C Common block /RPARC/ (defined in file 'rpar.for'):
      INCLUDE 'rparc.inc'
C     rparc.inc
C Storage locations of the common block are not altered.
C
C Common block /SCROC/:
      INCLUDE 'scro.inc'
C     scro.inc
C Storage locations of the common block are not altered.
C
C Subroutines and external functions required:
      EXTERNAL CURSOR
C     CURSOR..This file.
C
C Date: 2003, May 12
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER MTEXT
      PARAMETER (MTEXT=120)
      CHARACTER*(MTEXT) TEXT
      INTEGER I
      REAL STREET,H1,H2,V1,V2,AUX1,AUX2
C
      IF(KSCR(7).NE.0) THEN
        IF(IEND.LT.70) THEN
          WRITE(TEXT,'(A,I3,3I4)') 'END:',IEND,IY(4),IY(5),IY(6)
        ELSE
          WRITE(TEXT,'(A,I3,3I4)') 'END:',IEND
        END IF
        IF(KSCR(6).EQ.0) THEN
          CALL CURSOR(0,TEXT(1:19))
          KSCR(NSCR)=KSCR(NSCR)-1
        END IF
      ELSE
        WRITE(TEXT,'(A)') ' '
      END IF
      IF(KSCR(6).NE.0) THEN
        IF(KSCR(NSCR).GE.2+IPAUSE) THEN
          CALL CURSOR(0,TEXT(1:19))
          KSCR(NSCR)=KSCR(NSCR)-1
          WRITE(TEXT,'(A)') ' '
C         Erasing the rest of the history of the previous ray
          DO 10 I=1,KSCR(NSCR)-1
            CALL CURSOR(0,TEXT(1:19))
            KSCR(NSCR)=KSCR(NSCR)-1
   10     CONTINUE
        END IF
        CALL CURSOR(-5,TEXT(1:19))
        KSCR(NSCR)=NLINES
      END IF
      IF(KSCR(4).NE.0) THEN
        WRITE(TEXT,'(A)') 'Aiming'
        IF(KSCR(NSCR-1).EQ.KSCR(NSCR)) THEN
          IF(KSCR(3).NE.0) THEN
            CALL CURSOR(-1,TEXT(1:11))
          ELSE
            CALL CURSOR(-1,TEXT(1:7))
          END IF
        ELSE
          IF(KSCR(3).NE.0) THEN
            CALL CURSOR(NLINES-KSCR(NSCR-1),TEXT(1:11))
          ELSE
            CALL CURSOR(NLINES-KSCR(NSCR-1),TEXT(1:7))
          END IF
        END IF
        KSCR(NSCR)=KSCR(NSCR-1)
      END IF
C
C     Screen graphics:
      IF(KSCR(8).NE.0) THEN
C       Plotting the normalized shooting parameters at the screen:
C       (a) Scaling the parameters
        IF(ISRFX(2).EQ.0) THEN
C         Initial-value or one-parametric shooting
          IF(ANUM.GT.0.) THEN
            AUX1=G1/ANUM
          ELSE
            AUX1=0.5
          END IF
          IF(BNUM.GT.0.) THEN
            AUX2=G2/BNUM
          ELSE
            AUX2=0.5
          END IF
        ELSE
C         Two-parametric shooting
          AUX1=G1
          AUX2=G2
        END IF
C       (b) Plotting
        STREET=2.*WIDTH
        H1=(HMIN+HMAX+STREET+WIDTH)/2.+STREET+WIDTH
        H2=HMAX-WIDTH/2.              -STREET-WIDTH
        V1=(VMIN+VMAX+STREET+WIDTH)/2.+STREET+WIDTH
        V2=VMAX-WIDTH/2.              -STREET-WIDTH
        AUX1=H1+(H2-H1)*AUX1
        AUX2=V1+(V2-V1)*AUX2
        CALL NEWPEN(IABS(ISHEET)+1)
        CALL PLOT(AUX1-WIDTH,AUX2      ,3)
        CALL PLOT(AUX1+WIDTH,AUX2      ,2)
        CALL PLOT(AUX1      ,AUX2      ,2)
        CALL PLOT(AUX1      ,AUX2-WIDTH,2)
        CALL PLOT(AUX1      ,AUX2+WIDTH,2)
C
C       Check for non-existing rays:
        IF(IEND.GE.70) THEN
          RETURN
        END IF
C
C4.10   (c) Endpoints (or points at the reference surface)
C4.10   IF(ISHEET.GT.0) THEN
C4.10     IF(ISRFX(1).EQ.-1.AND.ISRFX(2).EQ.-2.) THEN
C4.10       AUX1=X1*H1A+H1B
C4.10       AUX2=X2*V2A+V2B
C4.10     ELSE IF(ISRFX(2).EQ.-1.AND.ISRFX(1).EQ.-2.) THEN
C4.10       AUX1=X2*H1A+H1B
C4.10       AUX2=X1*V2A+V2B
C4.10     ELSE IF(ISRFX(1).EQ.-1.AND.ISRFX(2).EQ.-3.) THEN
C4.10       AUX1=X1*H1A+H1B
C4.10       AUX2=X2*V3A+V3B
C4.10     ELSE IF(ISRFX(2).EQ.-1.AND.ISRFX(1).EQ.-3.) THEN
C4.10       AUX1=X2*H1A+H1B
C4.10       AUX2=X1*V3A+V3B
C4.10     ELSE IF(ISRFX(1).EQ.-2.AND.ISRFX(2).EQ.-3.) THEN
C4.10       AUX1=X1*H2A+H2B
C4.10       AUX2=X2*V3A+V3B
C4.10     ELSE IF(ISRFX(2).EQ.-2.AND.ISRFX(1).EQ.-3.) THEN
C4.10       AUX1=X2*H2A+H2B
C4.10       AUX2=X1*V3A+V3B
C4.10     ELSE
C4.10       AUX1=Y(3)*H1A+H1B
C4.10       AUX2=Y(4)*V2A+V2B
C4.10     END IF
C4.10     CALL PLOT(AUX1-WIDTH,AUX2      ,3)
C4.10     CALL PLOT(AUX1+WIDTH,AUX2      ,2)
C4.10     CALL PLOT(AUX1      ,AUX2      ,2)
C4.10     CALL PLOT(AUX1      ,AUX2-WIDTH,2)
C4.10     CALL PLOT(AUX1      ,AUX2+WIDTH,2)
C4.10   END IF
C       (c) Endpoints
        AUX1=Y(3)*H1A+H1B
        AUX2=Y(4)*V2A+V2B
        CALL PLOT(AUX1-WIDTH,AUX2      ,3)
        CALL PLOT(AUX1+WIDTH,AUX2      ,2)
        CALL PLOT(AUX1      ,AUX2      ,2)
        CALL PLOT(AUX1      ,AUX2-WIDTH,2)
        CALL PLOT(AUX1      ,AUX2+WIDTH,2)
        AUX2=Y(5)*V3A+V3B
        CALL PLOT(AUX1-WIDTH,AUX2      ,3)
        CALL PLOT(AUX1+WIDTH,AUX2      ,2)
        CALL PLOT(AUX1      ,AUX2      ,2)
        CALL PLOT(AUX1      ,AUX2-WIDTH,2)
        CALL PLOT(AUX1      ,AUX2+WIDTH,2)
        AUX1=Y(4)*H2A+H2B
        CALL PLOT(AUX1-WIDTH,AUX2      ,3)
        CALL PLOT(AUX1+WIDTH,AUX2      ,2)
        CALL PLOT(AUX1      ,AUX2      ,2)
        CALL PLOT(AUX1      ,AUX2-WIDTH,2)
        CALL PLOT(AUX1      ,AUX2+WIDTH,2)
      END IF
C
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE SCRO5(IWAVE)
      INTEGER IWAVE
C
C This screen output subroutine is called after termination of the
C computation of an elementary wave, and when terminating the complete
C ray tracing program.
C
C Input:
C     IWAVE...Zero when terminating the complete ray tracing program,
C             otherwise the index of the elementary wave which has been
C             computed (i.e. the output of the subroutine CODE1 from the
C             file 'code.for').
C
C No output.
C
C Common block /SCROC/:
      INCLUDE 'scro.inc'
C     scro.inc
C Storage locations of the common block are not altered.
C
C Subroutines and external functions required:
      EXTERNAL CURSOR,PLOT
C     CURSOR..This file.
C     PLOT... CalComp graphics subroutine.
C
C Date: 2003, May 12
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER MTEXT
      PARAMETER (MTEXT=120)
      CHARACTER*(MTEXT) TEXT
C
      IF(IWAVE.EQ.0) THEN
C       Erasing text screen:
        IF(KANSI.GE.1.OR.KPLUS.GE.3) THEN
          WRITE(TEXT,'(A)') ' '
          CALL CURSOR(-3,TEXT(1:20))
          KSCR(NSCR)=NLINES-1
        END IF
      ELSE
        IF(IPAUSE.GT.0) THEN
C         Waiting to confirm erasing of the ray diagram
          WRITE(TEXT,'(A)') 'PRESS ENTER'
          CALL CURSOR(0,TEXT(1:19))
          READ(*,*)
          KSCR(NSCR)=KSCR(NSCR)-1
        END IF
        IF(KSCR(NSCR).LT.NLINES-1) THEN
          WRITE(TEXT,'(A)') ' '
          CALL CURSOR(-2,TEXT(1:20))
          KSCR(NSCR)=NLINES-1
        END IF
C
C       Screen graphics:
        IF(KSCR(8).NE.0) THEN
C         Closing down plotting
          CALL PLOT(0.0,0.0,999)
        END IF
C
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE CURSOR(MOVE,TEXT)
      INTEGER MOVE
      CHARACTER*(*) TEXT
C
C This function moves the cursor and writes the given line of text.
C
C Input:
C     MOVE... Indication of the required cursor movement.
C             MOVE.GT.0: Move the cursor to line MOVE.
C             MOVE=0:  No special action, sequential writing.
C             MOVE=-1: Move the cursor 1 line upwards in order to
C                      overwrite the preceding line.
C             MOVE=-2: Return the cursor to the home position.
C             MOVE=-3: Erase the screen and return the cursor to the
C                      home position.
C             MOVE=-5: No action, sequential writing.  Return the cursor
C                      to the home position after writing.
C     TEXT... String to be written.
C
C No output:
C
C Common block /SCROC/:
      INCLUDE 'scro.inc'
C     scro.inc
C Storage locations of the common block are not altered.
C
C Date: 2003, April 24
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     No auxiliary storage locations.
C
      IF(KANSI.EQ.1) THEN
        IF(MOVE.GT.0) THEN
          IF(KPLUS.EQ.0) THEN
            WRITE(*,'(2A)') CHAR(27)//CHAR(91)//CHAR(48+MOVE/10)//
     *                      CHAR(48+MOD(MOVE,10))//';1H',TEXT
          ELSE
            WRITE(*,'(2A)') ' '//
     *                      CHAR(27)//CHAR(91)//CHAR(48+MOVE/10)//
     *                      CHAR(48+MOD(MOVE,10))//';1H',TEXT
          END IF
        ELSE IF(MOVE.EQ.0) THEN
          IF(KPLUS.EQ.0) THEN
            WRITE(*,'(2A)') TEXT
          ELSE
            WRITE(*,'(2A)') ' ',TEXT
          END IF
        ELSE IF(MOVE.EQ.-1) THEN
          IF(KPLUS.EQ.0) THEN
            WRITE(*,'(2A)') CHAR(27)//CHAR(91)//'1A',TEXT
          ELSE
            WRITE(*,'(2A)') ' '//CHAR(27)//CHAR(91)//'1A',TEXT
          END IF
        ELSE IF(MOVE.EQ.-2) THEN
          IF(KPLUS.EQ.0) THEN
            WRITE(*,'(2A)') CHAR(27)//CHAR(91)//'0;0H',TEXT
          ELSE
            WRITE(*,'(2A)') ' '//CHAR(27)//CHAR(91)//'0;0H',TEXT
          END IF
        ELSE IF(MOVE.EQ.-3) THEN
          IF(KPLUS.EQ.0) THEN
            WRITE(*,'(2A)') CHAR(27)//CHAR(91)//'2J',TEXT
          ELSE
            WRITE(*,'(2A)') ' '//CHAR(27)//CHAR(91)//'2J',TEXT
          END IF
        ELSE IF(MOVE.EQ.-5) THEN
          IF(KPLUS.EQ.0) THEN
            WRITE(*,'(2A)') TEXT,CHAR(27)//CHAR(91)//'0;0H'
          ELSE
            WRITE(*,'(3A)') ' ',TEXT,CHAR(27)//CHAR(91)//'0;0H'
          END IF
        ELSE
C         545
          CALL ERROR('545 in CURSOR: Icorrect value of argument MOVE')
C         This error should not appear.  Contact the authors.
        END IF
      ELSE
        IF(MOVE.EQ.-1) THEN
          IF(KPLUS.GE.1) THEN
            WRITE(*,'(2A)') '+',TEXT
          ELSE
            WRITE(*,'(2A)') TEXT
C           Preceding line cannot be overwritten if KPLUS.EQ.1.
          END IF
        ELSE IF(MOVE.EQ.-2.OR.MOVE.EQ.-3) THEN
          IF(KPLUS.GE.3) THEN
            WRITE(*,'(2A)') '1',TEXT
          ELSE IF(KPLUS.GE.1) THEN
            WRITE(*,'(2A)') ' ',TEXT
C           No cursor positioning available.
          ELSE
            WRITE(*,'(2A)') TEXT
C           No cursor positioning available.
          END IF
        ELSE
          IF(KPLUS.GE.1) THEN
            WRITE(*,'(2A)') ' ',TEXT
          ELSE
            WRITE(*,'(2A)') TEXT
          END IF
        END IF
      END IF
      RETURN
      END
C
C=======================================================================
C
C                                                 
C
C Specification of the used CalComp graphics subroutines:
C
C     SUBROUTINE PLOTS(I1,I2,I3)... Initializes plotting.  It is called
C             when starting the computation of the new elementary wave.
C             I1,I2,I3... Set to zeros.
C     SUBROUTINE PLOT(XPAGE,YPAGE,IPEN)... Moves pen or plots a line.
C             XPAGE, YPAGE... Coordinates, often in centimetres,
C               sometimes in inches.
C             IPEN... Controls the plotting:
C               IPEN=2... The pen is down during the movement, thus
C                 drawing a line.
C               IPEN=3... The pen is up during the movement.
C               IPEN=999... Terminates plotting initialized by the
C                 subroutine PLOTS.
C     SUBROUTINE NEWPEN(INP)... Changes the colour.
C             INP... Specifies the index of colour to be selected.
C                The colours are indexed 1,2,3,4,... .
C     All parameters are input parameters and should not be modified.
C
C     The plotting area is defined by variables HMIN,HMAX,VMIN,VMAX, and
C     WIDTH of the common block /SCROC/ and may be adjusted in the block
C     data subroutine SCROB.
C     SCROB
C
C=======================================================================
C