C SUBROUTINE FILE 'SCROPC' - SCREEN OUTPUT SUBROUTINES FOR PC'S C C BY VLASTISLAV CERVENY, LUDEK KLIMES, IVAN PSENCIK C C THIS FILE CONSISTS OF: C SCROB...BLOCK DATA SUBROUTINE DEFINING AUXILIARY COMMON BLOCK C /SCROC/ TO CONFIGURE THE SCREEN OUTPUT. C PARTICULARLY, THE DIMENSIONS OF THE PLOT AREA USED ARE C SPECIFIED IN THIS BLOCK DATA SUBROUTINE. 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 SCRO2...SCREEN OUTPUT SUBROUTINE CALLED WHEN STARTING THE COMPLETE C TRACING OF A NEW RAY. 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 SCRO4...SCREEN OUTPUT SUBROUTINE CALLED AFTER TERMINATION OF C TRACING THE RAY. 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 CURSOR..CHARACTER FUNCTION THAT RETURNS THE ANSI ESCAPE SEQUENCE C POSITIONING THE CURSOR AT THE BEGINNING OF THE GIVEN LINE. C SPECIFICATION OF THE USED CALCOMP GRAPHICS SUBROUTINES. C C ATTENTION: SUBROUTINE SCRO5 REQUIRES SOME 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 BRIEF DESCRIPTION OF THE OUTPUT SCREEN: 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 THE OUTPUT SCREEN IS SPLITTED 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 LEFT-HAND COLUMN: 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.R.T.5.4) C IS WRITTEN TO THE SCREEN. C THREE GRAPHICAL PANELS WITH RAY PROJECTIONS: C THE RIGHT-HAND COLUMN IS SPLITTED INTO 2*2 RECTANGLES. THE UPPER C LEFT-HAND RECTANGLE CONTAINS THE PROJECTION OF RAYS ONTO THE TOP C HORIZONTAL SIDE OF THE MODEL VOLUME (PLANE X1X2). THE BOTTOM C LEFT-HAND RECTANGLE CONTAINS THE FRONT WIEW OF RAYS (PROJECTION OF C RAYS ONTO THE FRONT SIDE X1X3 OF THE MODEL VOLUME). THE BOTTOM C RIGHT-HAND RECTANGLE CONTAINS THE PROJECTION OF RAYS ONTO THE C RIGHT-HAND VERTICAL SIDE X2X3 OF THE MODEL VOLUME. THE RAYS C INCREASE THEIR COLOUR INDEX BY ONE AT EACH POINT OF REFLECTION OR C TRANSMISSION. THE MODEL SIDE OF GENERALLY DIFFERENT DIMENSIONS C AND ASPECT RATIOS ARE SCALED INTO THE RECTANGLES OF EQUAL SIZE. C MOREOVER, IN CURVILINEAR COORDINATES THE MODEL VOLUME LIMITED BY C CURVED COORDINATE SURFACES IS SCALED INTO CUBE FOR THE PURPOSES OF C 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 ------------------------------------------------------------------ BLOCK DATA SCROB INTEGER JWAVE REAL HMIN,HMAX,VMIN,VMAX,WIDTH REAL H1A,H1B,H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD COMMON/SCROC/HMIN,HMAX,VMIN,VMAX,WIDTH,H1A,H1B, * H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD,JWAVE SAVE /SCROC/ C DIMENSIONS OF THE PLOT AREA (METRIC A4: 29.7*21.0): DATA HMIN,HMAX,VMIN,VMAX,WIDTH/7.45,29.66,0.00,21.00,0.045/ C DIMENSIONS OF THE PLOT AREA (US: 11.0*8.5): * DATA HMIN,HMAX,VMIN,VMAX,WIDTH/2.77,10.98,0.02, 8.48,0.017/ 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 H1A,H1B,H2A,H2B,V2A,V2B,V3A,V3B... AUXILIARY VARIABLES: C COEFFICIENTS OF THE LINEAR FUNCTIONS PROJECTING GENERAL C COORDINATES OF A POINT ON A RAY TO THE PLOT COORDINATES. C H1OLD,H2OLD,V2OLD,V3OLD... AUXILIARY VARIABLES: POSITIONS OF THE C PROJECTIONS OF THE LAST POINT OF A RAY TO THE SCREEN IN C PLOT COORDINATES. C JWAVE...STORAGE LOCATION FOR IWAVE MEDIATED FROM THE SUBROUTINE C SCRO1 TO SCRO2. C C DATE: 1994, JANUARY 26 C CODED BY LUDEK KLIMES C C======================================================================= C SUBROUTINE SCRO1(IWAVE) INTEGER 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 C NO OUTPUT. C C COMMON BLOCK /DCRT/ (SEE SUBROUTINE FILE 'RAY.FOR'): INTEGER MEND,MSTOR PARAMETER (MEND=128) PARAMETER (MSTOR=128) INTEGER KSTORE,NEXPS,NHLF,MODCRT REAL STORE,STEP,UEB,UEBPP,UEBPH,UEBHH,UEBDRT,BOUNDR(7) INTEGER NSRFCA,NEND,KEND(MEND),NSTOR,KSTOR(MSTOR) COMMON/DCRT/ KSTORE,NEXPS,NHLF,MODCRT,STORE,STEP,UEB,UEBPP,UEBPH, * UEBHH,UEBDRT,BOUNDR,NSRFCA,NEND,KEND,NSTOR,KSTOR C NONE OF THE STORAGE LOCATIONS OF THE COMMON BLOCK ARE ALTERED. C C COMMON BLOCK /SCROC/: INTEGER JWAVE REAL HMIN,HMAX,VMIN,VMAX,WIDTH REAL H1A,H1B,H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD COMMON/SCROC/HMIN,HMAX,VMIN,VMAX,WIDTH,H1A,H1B, * H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD,JWAVE 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: CHARACTER*8 CURSOR EXTERNAL SCROB,CURSOR,PLOTS,PLOT,NEWPEN C SCROB.. BLOCK DATA SUBROUTINE OF THIS FILE. C CURSOR... THIS FILE. C PLOTS,PLOT,NEWPEN... CALCOMP GRAPHICS SUBROUTINES. C C DATE: 1994, JANUARY 8 C CODED BY LUDEK KLIMES C C----------------------------------------------------------------------- C C AUXILIARY STORAGE LOCATIONS: REAL STREET,H1,H2,V1,V2 C JWAVE=IWAVE IF(IWAVE.GT.0) THEN C C ERASING SCREEN: WRITE(*,'(A)') CURSOR(0) C C SPACE BETWEEN FRAMES: STREET=2.*WIDTH C C COEFFICIENTS OF THE LINEAR PROJECTIONS ONTO THE SCREEN: H1A=((HMAX-HMIN-STREET)/2.-3.*WIDTH)/(BOUNDR(2)-BOUNDR(1)) H1B=HMIN+1.5*WIDTH-BOUNDR(1)*H1A H2A=((HMAX-HMIN-STREET)/2.-3.*WIDTH)/(BOUNDR(4)-BOUNDR(3)) H2B=HMAX-1.5*WIDTH-BOUNDR(4)*H2A V2A=((VMAX-VMIN-STREET)/2.-3.*WIDTH)/(BOUNDR(4)-BOUNDR(3)) V2B=VMAX-1.5*WIDTH-BOUNDR(4)*V2A V3A=((VMAX-VMIN-STREET)/2.-3.*WIDTH)/(BOUNDR(6)-BOUNDR(5)) V3B=VMIN+1.5*WIDTH-BOUNDR(5)*V3A 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 WRITING TO THE SCREEN: WRITE(*,'(A,A,I8,A)') CURSOR(3),'WAVE:',IWAVE,' ' WRITE(*,'(A,A)') CURSOR(2),' ' WRITE(*,'(A,A)') CURSOR(1),'NEW ELEMENTARY WAVE ' C END IF RETURN END 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'): INTEGER MSRFCA PARAMETER (MSRFCA=128) INTEGER ISB1I,ICB1I REAL YLI(6),YI(25),FSRFCA(MSRFCA) COMMON/INITC/ISB1I,ICB1I,YLI,YI,FSRFCA C NONE OF THE STORAGE LOCATIONS OF THE COMMON BLOCK ARE ALTERED. C C COMMON BLOCK /SCROC/: INTEGER JWAVE REAL HMIN,HMAX,VMIN,VMAX,WIDTH REAL H1A,H1B,H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD COMMON/SCROC/HMIN,HMAX,VMIN,VMAX,WIDTH,H1A,H1B, * H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD,JWAVE 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 CHARACTER*8 CURSOR C CURSOR..THIS FILE. C C DATE: 1991, SEPTEMBER 17 C CODED BY LUDEK KLIMES C C----------------------------------------------------------------------- C C NO AUXILIARY STORAGE LOCATIONS. C C WRITING TO THE SCREEN: WRITE(*,'(A,A)') CURSOR(1),'COMPUTING ' WRITE(*,'(A,A)') CURSOR(2),' ' WRITE(*,'(A,A,I8,A)') CURSOR(3),'WAVE:',JWAVE,' ' WRITE(*,'(A,A,I8,A)') CURSOR(4),'RAY: ',IRAY,' ' WRITE(*,'(A,A,F15.6)') CURSOR(5),'PAR1:',YI(20) WRITE(*,'(A,A,F15.6)') CURSOR(6),'PAR2:',YI(21) WRITE(*,'(A,A)') CURSOR(7),' ' WRITE(*,'(A,A)') CURSOR(8),' ISB ICB ISRF' 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 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/: INTEGER JWAVE REAL HMIN,HMAX,VMIN,VMAX,WIDTH REAL H1A,H1B,H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD COMMON/SCROC/HMIN,HMAX,VMIN,VMAX,WIDTH,H1A,H1B, * H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD,JWAVE 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 NSRFC,PLOT,NEWPEN INTEGER NSRFC C NSRFC... FILE 'MODEL.FOR'. C PLOT,NEWPEN... CALCOMP GRAPHICS SUBROUTINES. C C DATE: 1992, DECEMBER 3 C CODED BY LUDEK KLIMES C C----------------------------------------------------------------------- C C AUXILIARY STORAGE LOCATIONS: REAL H1NEW,H2NEW,V2NEW,V3NEW C C NUMBER OF LINES AVAILABLE ON THE SCREEN: NLINES: C NLINES MAY BE LOWER THAN THE ACTUAL NUMBER OF LINES BUT SHOULD NOT C EXCEED THAT. NLINES=25 IS A GOOD CHOICE FOR IBM-PC'S, BUT C NLINES=24 FITS ALSO VAX COMPUTERS. PARAMETER (NLINES=24) C C WRITING TO THE SCREEN: IF(IY(6).NE.0) THEN IF(2*IY(11).LE.NLINES-10) THEN IF(IY(8).NE.0) THEN WRITE(*,'('' .......'',3I4)') IY(4),IY(5),IY(6) ELSE WRITE(*,'('' '',3I4)') IY(4),IY(5),IY(6) END IF ELSE IF(IY(8).NE.0) THEN WRITE(*,'(''+.......'',3I4)') IY(4),IY(5),IY(6) ELSE WRITE(*,'(''+ '',3I4)') IY(4),IY(5),IY(6) END IF END IF END IF C 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 RETURN END 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). FOR A DETAILED DESCRIPTION SEE SUBROUTINE RAY C (SUBROUTINE FILE 'RAY.FOR'). 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/ (FILE 'RPAR.FOR'): INTEGER MREC PARAMETER (MREC=128) INTEGER ISRFR,IPOINT,ISRFX(2),NREC REAL XERR,AERR,XREC(2,MREC) REAL PAR1L,PAR2L,PAR1A,PAR2A,PAR1B,PAR2B,ANUM,BNUM COMMON/RPARD/ISRFR,IPOINT,ISRFX,NREC,AERR,XERR,XREC, * PAR1L,PAR2L,PAR1A,PAR2A,PAR1B,PAR2B,ANUM,BNUM C STORAGE LOCATIONS OF THE COMMON BLOCK ARE NOT ALTERED. C C COMMON BLOCK /RPARC/ (FILE 'RPAR.FOR'): INTEGER LURPAR,JRAY,JTYPE REAL G1,G2,X1,X2,X1G1,X2G1,X1G2,X2G2 COMMON/RPARC/LURPAR,JRAY,JTYPE,G1,G2,X1,X2,X1G1,X2G1,X1G2,X2G2 C STORAGE LOCATIONS OF THE COMMON BLOCK ARE NOT ALTERED. C C COMMON BLOCK /SCROC/: INTEGER JWAVE REAL HMIN,HMAX,VMIN,VMAX,WIDTH REAL H1A,H1B,H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD COMMON/SCROC/HMIN,HMAX,VMIN,VMAX,WIDTH,H1A,H1B, * H2A,H2B,V2A,V2B,V3A,V3B,H1OLD,H2OLD,V2OLD,V3OLD,JWAVE C STORAGE LOCATIONS OF THE COMMON BLOCK ARE NOT ALTERED. C C SUBROUTINES AND EXTERNAL FUNCTIONS REQUIRED: EXTERNAL CURSOR CHARACTER*8 CURSOR C CURSOR..THIS FILE. C C DATE: 1994, JANUARY 8 C CODED BY LUDEK KLIMES C C----------------------------------------------------------------------- C C AUXILIARY STORAGE LOCATIONS: INTEGER I,NLINES REAL AUX1,AUX2 C C NUMBER OF LINES AVAILABLE ON THE SCREEN: NLINES: C NLINES MAY BE LOWER THAN THE ACTUAL NUMBER OF LINES BUT SHOULD NOT C EXCEED THAT. NLINES=25 IS A GOOD CHOICE FOR IBM-PC'S, BUT C NLINES=24 FITS ALSO VAX COMPUTERS. PARAMETER (NLINES=24) C C WRITING TO THE SCREEN: WRITE(*,'('' END:'',I3,3I4)') IEND,IY(4),IY(5),IY(6) DO 10 I=1,NLINES-10-2*IY(11) WRITE(*,'('' '')') 10 CONTINUE WRITE(*,'(A,A)') CURSOR(1),' ' C 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)) 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) ENDPOINTS (OR POINTS AT THE REFERENCE SURFACE) IF(ISHEET.GT.0) THEN IF(ISRFX(1).EQ.-1.AND.ISRFX(2).EQ.-2.) THEN AUX1=X1*H1A+H1B AUX2=X2*V2A+V2B ELSE IF(ISRFX(2).EQ.-1.AND.ISRFX(1).EQ.-2.) THEN AUX1=X2*H1A+H1B AUX2=X1*V2A+V2B ELSE IF(ISRFX(1).EQ.-1.AND.ISRFX(2).EQ.-3.) THEN AUX1=X1*H1A+H1B AUX2=X2*V3A+V3B ELSE IF(ISRFX(2).EQ.-1.AND.ISRFX(1).EQ.-3.) THEN AUX1=X2*H1A+H1B AUX2=X1*V3A+V3B ELSE IF(ISRFX(1).EQ.-2.AND.ISRFX(2).EQ.-3.) THEN AUX1=X1*H2A+H2B AUX2=X2*V3A+V3B ELSE IF(ISRFX(2).EQ.-2.AND.ISRFX(1).EQ.-3.) THEN AUX1=X2*H2A+H2B AUX2=X1*V3A+V3B ELSE AUX1=Y(3)*H1A+H1B AUX2=Y(4)*V2A+V2B END IF 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 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 SUBROUTINES AND EXTERNAL FUNCTIONS REQUIRED: EXTERNAL CURSOR,PLOT CHARACTER*8 CURSOR C CURSOR..THIS FILE. C PLOT... CALCOMP GRAPHICS SUBROUTINE. C C DATE: 1990, NOVEMBER 16 C CODED BY LUDEK KLIMES C C----------------------------------------------------------------------- C C NO AUXILIARY STORAGE LOCATIONS. C IF(IWAVE.EQ.0) THEN C ERASING TEXT SCREEN: WRITE(*,'(A)') CURSOR(0) ELSE C WAITING TO CONFIRM ERASING OF THE RAY DIAGRAM WRITE(*,'(A,A)') CURSOR(1),'PRESS ENTER ' READ(*,*) C CLOSING DOWN PLOTTING CALL PLOT(0.0,0.0,999) END IF RETURN END C C======================================================================= C CHARACTER*8 FUNCTION CURSOR(LINE) INTEGER LINE C C THIS FUNCTION RETURNS THE ANSI ESCAPE SEQUENCE POSITIONING THE CURSOR C AT THE BEGINNING OF THE GIVEN LINE. C C INPUT: C LINE... INDEX OF THE GIVEN LINE, ZERO OR NEGATIVE. IF LINE.LE.0, C THE ENTIRE SCREEN IS TO BE ERASED AND THE CURSOR RETURNED C TO THE HOME POSITION. C C OUTPUT: C CURSOR..ESCAPE SEQUENCE POSITIONING THE CURSOR AT THE BEGINNING OF C THE GIVEN LINE, OR ERASING THE SCREEN. C C NO SUBROUTINES AND EXTERNAL FUNCTIONS REQUIRED. C C DATE: 1990, NOVEMBER 9 C CODED BY LUDEK KLIMES C C----------------------------------------------------------------------- C C NO AUXILIARY STORAGE LOCATIONS. C IF(LINE.LE.0) THEN CURSOR=' '//CHAR(27)//CHAR(91)//'2J' ELSE CURSOR=' '//CHAR(27)//CHAR(91)// * CHAR(48+LINE/10)//CHAR(48+MOD(LINE,10))//CHAR(59)//'1H' END IF RETURN END 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 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 COLOR. C INP... SPECIFIES THE NUMBER OF COLOR TO BE SELECTED. 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 C======================================================================= C