diff options
Diffstat (limited to 'sys/gio/ncarutil/srface.f')
| -rw-r--r-- | sys/gio/ncarutil/srface.f | 1347 |
1 files changed, 1347 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/srface.f b/sys/gio/ncarutil/srface.f new file mode 100644 index 00000000..8a5981db --- /dev/null +++ b/sys/gio/ncarutil/srface.f @@ -0,0 +1,1347 @@ + SUBROUTINE SRFACE (X,Y,Z,M,MX,NX,NY,S,STEREO) +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C +C DIMENSION OF X(NX),Y(NY),Z(MX,NY),M(2,NX,NY),S(6) +C ARGUMENTS +C +C LATEST REVISION MARCH 1984 +C +C PURPOSE SRFACE DRAWS A PERSPECTIVE PICTURE OF A +C FUNCTION OF TWO VARIABLES WITH HIDDEN LINES +C REMOVED. THE FUNCTION IS APPROXIMATED BY A +C TWO-DIMENSIONAL ARRAY OF HEIGHTS. +C +C USAGE IF THE FOLLOWING ASSUMPTIONS ARE MET, USE +C CALL EZSRFC (Z,M,N,ANGH,ANGV,WORK) +C +C ASSUMPTIONS: +C .THE ENTIRE ARRAY IS TO BE DRAWN, +C .THE DATA IS EQUALLY SPACED (IN THE +C X-Y PLANE), +C .NO STEREO PAIRS, +C .SCALING IS CHOSEN INTERNALLY. +C +C IF THESE ASSUMPTIONS ARE NOT MET USE +C CALL SRFACE (X,Y,Z,M,MX,NX,NY,S, +C STEREO) +C +C ARGUMENTS +C +C ON INPUT Z +C FOR EZSRFC THE M BY N ARRAY TO BE DRAWN. +C +C M +C THE FIRST DIMENSION OF Z. +C +C N +C THE SECOND DIMENSION OF Z. +C +C ANGH +C ANGLE IN DEGREES IN THE X-Y PLANE TO THE +C LINE OF SIGHT (COUNTER-CLOCK WISE FROM +C THE PLUS-X AXIS). +C +C ANGV +C ANGLE IN DEGREES FROM THE X-Y PLANE TO +C THE LINE OF SIGHT (POSITIVE ANGLES ARE +C ABOVE THE MIDDLE Z, NEGATIVE BELOW). +C +C WORK +C A SCRATCH STORAGE DIMENSIONED AT LEAST +C 2*M*N+M+N. +C +C ON OUTPUT Z, M, N, ANGH, ANGV ARE UNCHANGED. WORK +C FOR EZSRFC HAS BEEN WRITTEN IN. +C +C +C ARGUMENTS +C +C ON INPUT X +C FOR SRFACE A LINEAR ARRAY NX LONG CONTAINING THE X +C COORDINATES OF THE POINTS IN THE SURFACE +C APPROXIMATION. SEE NOTE, BELOW. +C +C Y +C THE LINEAR ARRAY NY LONG CONTAINING THE +C Y COORDINATES OF THE POINTS IN THE +C SURFACE APPROXIMATION. SEE NOTE, BELOW. +C +C Z +C AN ARRAY MX BY NY CONTAINING THE SURFACE +C TO BE DRAWN IN NX BY NY CELLS. +C Z(I,J) = F(X(I),Y(J)). SEE NOTE, BELOW. +C +C M +C SCRATCH ARRAY AT LEAST 2*NX*NY WORDS +C LONG. +C +C MX +C FIRST DIMENSION OF Z. +C +C NX +C NUMBER OF POINTS IN THE X DIRECTION +C IN Z. WHEN PLOTTING AN ENTIRE ARRAY, +C MX=NX. SEE APPENDIX 1 OF THE GRAPHICS +C CHAPTER FOR AN EXPLANATION OF USING THIS +C ARGUMENT LIST TO PROCESS ANY PART OF AN +C ARRAY. +C +C NY +C NUMBER OF POINTS IN THE Y DIRECTION IN Z. +C +C S +C S DEFINES THE LINE OF SIGHT. THE VIEWER'S +C EYE IS AT (S(1), S(2), S(3)) AND THE +C POINT LOOKED AT IS AT (S(4), S(5), S(6)). +C THE EYE SHOULD BE OUTSIDE THE BLOCK WITH +C OPPOSITE CORNERS (X(1), Y(1), ZMIN) AND +C (X(NX), Y(NY), ZMAX) AND THE POINT LOOKED +C AT SHOULD BE INSIDE IT. FOR A NICE +C PERSPECTIVE EFFECT, THE DISTANCE BETWEEN +C THE EYE AND THE POINT LOOKED AT SHOULD BE +C 5 TO 10 TIMES THE SIZE OF THE BLOCK. SEE +C NOTE, BELOW. +C +C STEREO +C FLAG TO INDICATE IF STEREO PAIRS ARE TO +C BE DRAWN. 0.0 MEANS NO STEREO PAIR (ONE +C PICTURE). NON-ZERO MEANS PUT OUT TWO +C PICTURES. THE VALUE OF STEREO IS THE +C RELATIVE ANGLE BETWEEN THE EYES. A VALUE +C OF 1.0 PRODUCES STANDARD SEPARATION. +C NEGATIVE STEREO REVERSES THE LEFT AND +C RIGHT FIGURES. +C +C ON OUTPUT X, Y, Z, MX, NX, NY, S, STEREO ARE +C FOR SRFACE UNCHANGED. M HAS BEEN WRITTEN IN. +C +C NOTES . THE RANGE OF Z COMPARED WITH THE RANGE +C OF X AND Y DETERMINES THE SHAPE OF THE +C PICTURE. THEY ARE ASSUMED TO BE IN THE +C SAME UNITS AND NOT WILDLY DIFFERENT IN +C MAGNITUDE. S IS ASSUMED TO BE IN THE +C SAME UNITS AS X, Y, AND Z. +C . PICTURE SIZE CAN BE MADE RELATIVE TO +C DISTANCE. SEE COMMENTS IN SETR. +C . TRN32S CAN BE USED TO TRANSLATE FROM 3 +C SPACE TO 2 SPACE. SEE COMMENTS THERE. +C . DATA WITH EXTREME DISCONTINUITIES MAY +C CAUSE VISIBILITY ERRORS. IF THIS PROBLEM +C OCCURS, USE A DISTANT EYE POSITION +C AWAY FROM THE +Z AXIS. +C . THE DEFAULT LINE COLOR IS SET TO +C COLOR INDEX 1. IF THE USER WISHES TO +C CHANGE THE LINE COLOR, HE CAN DO SO BY +C DEFINING COLOR INDEX 1 BEFORE CALLING +C SRFACE, OR BY PUTTING THE COMMON BLOCK +C SRFINT IN HIS CALLING PROGRAM AND +C DEFINING AND USING COLOR INDEX ISRFMJ +C (DEFAULTED TO 1 IN BLOCKDATA.) +C +C ENTRY POINTS SRFACE, SRFGK, EZSRFC, SETR, DRAWS, TRN32S, +C CLSET, CTCELL, SRFABD +C +C COMMON BLOCKS PWRZ1S, SRFBLK, SRFINT, SRFIP1 +C +C I/O PLOTS +C +C PRECISION SINGLE +C +C LANGUAGE FORTRAN +C +C HISTORY CONVERTED TO FORTRAN 77 AND GKS IN MARCH 1984. +C +C PREPARED FOR SIGGRAPH, AUGUST 1976. +C +C STANDARDIZED IN JANUARY 1973. +C +C WRITTEN IN DECEMBER 1971. REPLACED K.S.+G. +C ALGORITHM CALLED SOLIDS AT NCAR. +C +C +C ALGORITHM HIGHEST SO FAR IS VISIBLE FROM ABOVE. (SEE +C REFERENCE.) +C +C REFERENCE WRIGHT, T.J., A TWO SPACE SOLUTION TO THE +C HIDDEN LINE PROBLEM FOR PLOTTING A FUNCTION +C OF TWO VARIABLES. IEEE TRANS. COMP., +C PP 28-33, JANUARY 1973. +C +C ACCURACY IF THE ENDS OF A LINE SEGMENT ARE VISIBLE, +C THE MIDDLE IS ASSUMED VISIBLE. +C +C TIMING PROPORTIONAL TO NX*NY. +C +C +C INTERNAL PARAMETERS NAME DEFAULT FUNCTION +C ---- ------- -------- +C IFR 1 -1 CALL FRAME FIRST. +C 0 DO NOT CALL FRAME. +C +1 CALL FRAME WHEN DONE. +c +NOAO: The value of ifr has been changed from its default of +1 to 0. +c -NOAO +C +C ISTP 0 STEREO TYPE IF STEREO +C NON-ZERO. +C -1 ALTERNATING FRAMES, +C SLIGHTLY OFFSET (FOR +C MOVIES. IROTS = 0). +C 0 BLANK FRAME BETWEEN +C FOR STEREO SLIDE. +C IROTS = 1). +C +1 BOTH ON SAME FRAME. +C (LEFT PICTURE TO LEFT +C SIDE. IROTS = 0). +C +C IROTS 0 0 +Z IN VERTICAL PLOTTING +C DIRECTION (CINE MODE). +C +1 +Z IN HORIZONTAL +C PLOTTING DIRECTION +C (COMIC MODE). +C +C IDRX 1 +1 DRAW LINES OF CONSTANT +C X. +C 0 DO NOT. +C +C IDRY 1 +1 DRAW LINES OF CONSTANT +C Y. +C 0 DO NOT. +C +C IDRZ 0 +1 DRAW LINES OF CONSTANT +C Z (CONTOUR LINES). +C 0 DO NOT. +C +C IUPPER 0 +1 DRAW UPPER SIDE OF +C SURFACE. +C 0 DRAW BOTH SIDES. +C -1 DRAW LOWER SIDE. +C +C ISKIRT 0 +1 DRAW A SKIRT AROUND THE +C SURFACE. +C BOTTOM = HSKIRT. +C 0 DO NOT. +C +C NCLA 6 APPROXIMATE NUMBER OF +C LEVELS OF CONSTANT Z THAT +C ARE DRAWN IF LEVELS ARE NOT +C SPECIFIED. 40 LEVELS +C MAXIMUM. +C +C THETA .02 ANGLE IN RADIANS BETWEEN +C EYES FOR STEREO PAIRS. +C +C HSKIRT 0. HEIGHT OF SKIRT +C (IF ISKIRT = 1). +C +C CHI 0. HIGHEST LEVEL OF CONSTANT +C Z. +C +C CLO 0. LOWEST LEVEL OF CONSTANT Z. +C +C CINC 0. INCREMENT BETWEEN LEVELS. +C +C [IF CHI, CLO, OR CINC IS ZERO, A NICE +C VALUE IS GENERATED AUTOMATICALLY.] +C +C IOFFP 0 FLAG TO CONTROL USE OF SPECIAL +C VALUE FEATURE. DO NOT HAVE +C BOTH IOFFP=1 AND ISKIRT=1. +C 0 FEATURE NOT IN USE +C +1 FEATURE IN USE. NO LINES +C DRAWN TO DATA POINTS IN Z +C THAT ARE EQUAL TO SPVAL. +C +C SPVAL 0. SPECIAL VALUE USED TO MARK UN- +C KNOWN DATA WHEN IOFFP=1. +C +C +C + DIMENSION X(NX) ,Y(NY) ,Z(MX,NY), M(2,NX,NY), + 1 S(6) + DIMENSION WIN1(4) ,VP1(4) ,LASF(13) + COMMON /SRFINT/ ISRFMJ ,ISRFMN ,ISRFTX +c +NOAO: common block added 4NOV85 to allow user control of viewport + common /noaovp/ vpx1, vpx2, vpy1, vpy2 +c -NOAO +c +NOAO: Blockdata srfabd rewritten as run time initialization +c EXTERNAL SRFABD + call srfabd +c -NOAO + CALL Q8QST4 ('GRAPHX','SRFACE','SRFACE','VERSION 01') +C +C THIS DRIVER SAVES THE CURRENT NORMALIZATION TRANSFORMATION +C INFORMATION, DEFINES THE NORMALIZATION TRANSFORMATION +C APPROPRIATE FOR SRFGK, CALLS SRFGK, AND RESTORES THE ORIGINAL +C NORMALIZATION TRANSFORMATION. +C +C GET CURRENT NORMALIZATION TRANSFORMATION NUMBER +C + CALL GQCNTN (IER,NTORIG) +C +C STORE WINDOW AND VIEWPORT OF NORMALIZATION TRANSFORMATION 1 +C + CALL GQNT (NTORIG,IER,WIN1,VP1) + CALL GETUSV('LS',IOLLS) +C +C SET WINDOW AND VIEWPORT FOR SRFGK +C +c CALL SET(0.,1.,0.,1.,1.,1024.,1.,1024.,1) +c +NOAO: viewport limits now stored in common block noaovp + CALL SET(vpx1, vpx2, vpy1, vpy2, 1.0, 1024., 1.0, 1024., 1) +c -NOAO +C +C SET LINE COLOR TO INDIVIDUAL (SAVE CURRENT SETTING) +C + CALL GQASF (IER,LASF) + LASFSV = LASF(3) + LASF(3) = 1 + CALL GSASF(LASF) +C +C SET LINE COLOR INDEX TO COMMON VARIABLE ISRFMJ (SAVE +C CURRENT SETTING) +C + CALL GQPLCI (IER,LCISV) + CALL GSPLCI (ISRFMJ) +C +C DRAW PLOT +C + CALL SRFGK (X,Y,Z,M,MX,NX,NY,S,STEREO) +C +C RESTORE INITIAL LINE COLOR SETTINGS +C + LASF(3) = LASFSV + CALL GSASF(LASF) + CALL GSPLCI (LCISV) +C +C RESTORE ORIGINAL NORMALIZATION TRANSFORMATION +C + CALL SET(VP1(1),VP1(2),VP1(3),VP1(4),WIN1(1),WIN1(2), + - WIN1(3),WIN1(4),IOLLS) + CALL GSELNT (NTORIG) +C + RETURN + END + SUBROUTINE SRFGK (X,Y,Z,M,MX,NX,NY,S,STEREO) +C + DIMENSION X(NX) ,Y(NY) ,Z(MX,NY) ,M(2,NX,NY) , + 1 S(6) + DIMENSION MXS(2) ,MXF(2) ,MXJ(2) ,MYS(2), + 1 MYF(2) ,MYJ(2) + COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41) ,NCL, + 1 LL ,FACT ,IROT ,NDRZ, + 2 NUPPER ,NRSWT ,BIGD ,UMIN, + 3 UMAX ,VMIN ,VMAX ,RZERO, + 4 IOFFP ,NSPVAL ,SPVAL ,BIGEST + COMMON /PWRZ1S/ XXMIN ,XXMAX ,YYMIN ,YYMAX, + 1 ZZMIN ,ZZMAX ,DELCRT ,EYEX, + 2 EYEY ,EYEZ + COMMON /SRFIP1/ IFR ,ISTP ,IROTS ,IDRX , + 1 IDRY ,IDRZ ,IUPPER ,ISKIRT, + 2 NCLA ,THETA ,HSKIRT ,CHI, + 3 CLO ,CINC ,ISPVAL +c +NOAO: + common /noaovp/ vpx1, vpx2, vpy1, vpy2 +c -NOAO +C + DATA JF, IF, LY, LX, ICNST /1, 1, 2, 2, 0/ + CALL Q8QST4 ('GRAPHX','SRFACE','SRFGK','VERSION 01') + BIGEST = R1MACH(2) + MMXX = MX + NNXX = NX + NNYY = NY + STER = STEREO + NXP1 = NNXX+1 + NYP1 = NNYY+1 + NLA = NCLA + NSPVAL = ISPVAL + NDRZ = IDRZ + IF (IDRZ .NE. 0) + 1 CALL CLSET (Z,MMXX,NNXX,NNYY,CHI,CLO,CINC,NLA,40,CL,NCL, + 2 ICNST,IOFFP,SPVAL,BIGEST) + IF (IDRZ .NE. 0) NDRZ = 1-ICNST + STHETA = SIN(STER*THETA) + CTHETA = COS(STER*THETA) + RX = S(1)-S(4) + RY = S(2)-S(5) + RZ = S(3)-S(6) + D1 = SQRT(RX*RX+RY*RY+RZ*RZ) + D2 = SQRT(RX*RX+RY*RY) + DX = 0. + DY = 0. + IF (STEREO .EQ. 0.) GO TO 20 + D1 = D1*STEREO*THETA + IF (D2 .GT. 0.) GO TO 10 + DX = D1 + GO TO 20 + 10 AGL = ATAN2(RX,-RY) + DX = D1*COS(AGL) + DY = D1*SIN(AGL) + 20 IROT = IROTS + NPIC = 1 + IF (STER .NE. 0.) NPIC = 2 + FACT = 1. + IF (NRSWT .NE. 0) FACT = RZERO/D1 + IF (ISTP.EQ.0 .AND. STER.NE.0.) IROT = 1 + DO 570 IPIC=1,NPIC + NUPPER = IUPPER + IF (IFR .LT. 0) CALL FRAME +C +C SET UP MAPING FROM FLOATING POINT 3-SPACE TO CRT SPACE. +C + SIGN1 = IPIC*2-3 + EYEX = S(1)+SIGN1*DX + POIX = S(4)+SIGN1*DX + EYEY = S(2)+SIGN1*DY + POIY = S(5)+SIGN1*DY + EYEZ = S(3) + POIZ = S(6) + LL = 0 + XEYE = EYEX + YEYE = EYEY + ZEYE = EYEZ + CALL TRN32S (POIX,POIY,POIZ,XEYE,YEYE,ZEYE,0) + LL = IPIC+2*ISTP+3 + IF (STER .EQ. 0.) LL = 1 + IF (NRSWT .NE. 0) GO TO 100 + XXMIN = X(1) + XXMAX = X(NNXX) + YYMIN = Y(1) + YYMAX = Y(NNYY) + UMIN = BIGEST + VMIN = BIGEST + ZZMIN = BIGEST + UMAX = -UMIN + VMAX = -VMIN + ZZMAX = -ZZMIN + DO 40 J=1,NNYY + DO 30 I=1,NNXX + ZZ = Z(I,J) + IF (IOFFP.EQ.1 .AND. ZZ.EQ.SPVAL) GO TO 30 + ZZMAX = AMAX1(ZZMAX,ZZ) + ZZMIN = AMIN1(ZZMIN,ZZ) + CALL TRN32S (X(I),Y(J),Z(I,J),UT,VT,DUMMY,1) + UMAX = AMAX1(UMAX,UT) + UMIN = AMIN1(UMIN,UT) + VMAX = AMAX1(VMAX,VT) + VMIN = AMIN1(VMIN,VT) + 30 CONTINUE + 40 CONTINUE + IF (ISKIRT .NE. 1) GO TO 70 + NXSTP = NNXX-1 + NYSTP = NNYY-1 + DO 60 J=1,NNYY,NYSTP + DO 50 I=1,NNXX,NXSTP + CALL TRN32S (X(I),Y(J),HSKIRT,UT,VT,DUMMY,1) + UMAX = AMAX1(UMAX,UT) + UMIN = AMIN1(UMIN,UT) + VMAX = AMAX1(VMAX,VT) + VMIN = AMIN1(VMIN,VT) + 50 CONTINUE + 60 CONTINUE + 70 CONTINUE + WIDTH = UMAX-UMIN + HIGHT = VMAX-VMIN + DIF = .5*(WIDTH-HIGHT) + IF (DIF) 80,100, 90 + 80 UMIN = UMIN+DIF + UMAX = UMAX-DIF + GO TO 100 + 90 VMIN = VMIN-DIF + VMAX = VMAX+DIF + 100 XEYE = EYEX + YEYE = EYEY + ZEYE = EYEZ + CALL TRN32S (POIX,POIY,POIZ,XEYE,YEYE,ZEYE,0) + DO 120 J=1,NNYY + DO 110 I=1,NNXX + CALL TRN32S (X(I),Y(J),Z(I,J),UT,VT,DUMMY,1) + M(1,I,J) = UT + M(2,I,J) = VT + 110 CONTINUE + 120 CONTINUE +C +C INITIALIZE UPPER AND LOWER VISIBILITY ARRAYS +C + DO 130 K=1,1024 + LIMU(K) = 0 + LIML(K) = 1024 + 130 CONTINUE +C +C FIND ORDER TO DRAW LINES +C + NXPASS = 1 + IF (S(1) .GE. X(NNXX)) GO TO 160 + IF (S(1) .LE. X(1)) GO TO 170 + DO 140 I=2,NNXX + LX = I + IF (S(1) .LE. X(I)) GO TO 150 + 140 CONTINUE + 150 MXS(1) = LX-1 + MXJ(1) = -1 + MXF(1) = 1 + MXS(2) = LX + MXJ(2) = 1 + MXF(2) = NNXX + NXPASS = 2 + GO TO 180 + 160 MXS(1) = NNXX + MXJ(1) = -1 + MXF(1) = 1 + GO TO 180 + 170 MXS(1) = 1 + MXJ(1) = 1 + MXF(1) = NNXX + 180 NYPASS = 1 + IF (S(2) .GE. Y(NNYY)) GO TO 210 + IF (S(2) .LE. Y(1)) GO TO 220 + DO 190 J=2,NNYY + LY = J + IF (S(2) .LE. Y(J)) GO TO 200 + 190 CONTINUE + 200 MYS(1) = LY-1 + MYJ(1) = -1 + MYF(1) = 1 + MYS(2) = LY + MYJ(2) = 1 + MYF(2) = NNYY + NYPASS = 2 + GO TO 230 + 210 MYS(1) = NNYY + MYJ(1) = -1 + MYF(1) = 1 + GO TO 230 + 220 MYS(1) = 1 + MYJ(1) = 1 + MYF(1) = NNYY +C +C PUT ON SKIRT ON FRONT SIDE IF WANTED +C + 230 IF (NXPASS.EQ.2 .AND. NYPASS.EQ.2) GO TO 490 + IF (ISKIRT .EQ. 0) GO TO 290 + IN = MXS(1) + IF = MXF(1) + JN = MYS(1) + JF = MYF(1) + IF (NYPASS .NE. 1) GO TO 260 + CALL TRN32S (X(1),Y(JN),HSKIRT,UX1,VX1,DUMMY,1) + CALL TRN32S (X(NNXX),Y(JN),HSKIRT,UX2,VX2,DUMMY,1) + QU = (UX2-UX1)/(X(NNXX)-X(1)) + QV = (VX2-VX1)/(X(NNXX)-X(1)) + YNOW = Y(JN) + DO 240 I=1,NNXX + CALL TRN32S (X(I),YNOW,HSKIRT,RU,RV,DUMMY,1) + CALL DRAWS (IFIX(RU),IFIX(RV),M(1,I,JN),M(2,I,JN),1,0) + 240 CONTINUE + CALL DRAWS (IFIX(UX1),IFIX(VX1),IFIX(UX2),IFIX(VX2),1,1) + IF (IDRY .NE. 0) GO TO 260 + DO 250 I=2,NNXX + CALL DRAWS (M(1,I-1,JN),M(2,I-1,JN),M(1,I,JN),M(2,I,JN),1,1) + 250 CONTINUE + 260 IF (NXPASS .NE. 1) GO TO 290 + CALL TRN32S (X(IN),Y(1),HSKIRT,UY1,VY1,DUMMY,1) + CALL TRN32S (X(IN),Y(NNYY),HSKIRT,UY2,VY2,DUMMY,1) + QU = (UY2-UY1)/(Y(NNYY)-Y(1)) + QV = (VY2-VY1)/(Y(NNYY)-Y(1)) + XNOW = X(IN) + DO 270 J=1,NNYY + CALL TRN32S (XNOW,Y(J),HSKIRT,RU,RV,DUMMY,1) + CALL DRAWS (IFIX(RU),IFIX(RV),M(1,IN,J),M(2,IN,J),1,0) + 270 CONTINUE + CALL DRAWS (IFIX(UY1),IFIX(VY1),IFIX(UY2),IFIX(VY2),1,1) + IF (IDRX .NE. 0) GO TO 290 + DO 280 J=2,NNYY + CALL DRAWS (M(1,IN,J-1),M(2,IN,J-1),M(1,IN,J),M(2,IN,J),1,1) + 280 CONTINUE +C +C PICK PROPER ALGORITHM +C + 290 LI = MXJ(1) + MI = MXS(1)-LI + NI = IABS(MI-MXF(1)) + LJ = MYJ(1) + MJ = MYS(1)-LJ + NJ = IABS(MJ-MYF(1)) +C +C WHEN LINE OF SIGHT IS NEARER TO PARALLEL TO THE X AXIS, +C HAVE J LOOP OUTER-MOST, OTHERWISE HAVE I LOOP OUTER-MOST. +C + IF (ABS(RX) .LE. ABS(RY)) GO TO 360 + IF (ISKIRT.NE.0 .OR. NYPASS.NE.1) GO TO 310 + I = MXS(1) + DO 300 J=2,NNYY + CALL DRAWS (M(1,I,J-1),M(2,I,J-1),M(1,I,J),M(2,I,J),0,1) + 300 CONTINUE + 310 DO 350 II=1,NNXX + I = MI+II*LI + IPLI = I+LI + IF (NYPASS .EQ. 1) GO TO 320 + K = MYS(1) + L = MYS(2) + IF (IDRX .NE. 0) + 1 CALL DRAWS (M(1,I,K),M(2,I,K),M(1,I,L),M(2,I,L),1,1) + IF (NDRZ.NE.0 .AND. II.NE.NI) + 1 CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI),K) + 320 DO 340 JPASS=1,NYPASS + LJ = MYJ(JPASS) + MJ = MYS(JPASS)-LJ + NJ = IABS(MJ-MYF(JPASS)) + DO 330 JJ=1,NJ + J = MJ+JJ*LJ + JPLJ = J+LJ + IF (IDRX.NE.0 .AND. JJ.NE.NJ) + 1 CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I,JPLJ), + 2 M(2,I,JPLJ),1,1) + IF (I.NE.MXF(1) .AND. IDRY.NE.0) + 1 CALL DRAWS (M(1,IPLI,J),M(2,IPLI,J),M(1,I,J), + 2 M(2,I,J),1,1) + IF (NDRZ.NE.0 .AND. JJ.NE.NJ .AND. II.NE.NNXX) + 1 CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI), + 2 MIN0(J,J+LJ)) + 330 CONTINUE + 340 CONTINUE + 350 CONTINUE + GO TO 430 + 360 IF (ISKIRT.NE.0 .OR. NXPASS.NE.1) GO TO 380 + J = MYS(1) + DO 370 I=2,NNXX + CALL DRAWS (M(1,I-1,J),M(2,I-1,J),M(1,I,J),M(2,I,J),0,1) + 370 CONTINUE + 380 DO 420 JJ=1,NNYY + J = MJ+JJ*LJ + JPLJ = J+LJ + IF (NXPASS .EQ. 1) GO TO 390 + K = MXS(1) + L = MXS(2) + IF (IDRY .NE. 0) + 1 CALL DRAWS (M(1,K,J),M(2,K,J),M(1,L,J),M(2,L,J),1,1) + IF (NDRZ.NE.0 .AND. JJ.NE.NJ) + 1 CALL CTCELL (Z,MMXX,NNXX,NNYY,M,K,MIN0(J,J+LJ)) + 390 DO 410 IPASS=1,NXPASS + LI = MXJ(IPASS) + MI = MXS(IPASS)-LI + NI = IABS(MI-MXF(IPASS)) + DO 400 II=1,NI + I = MI+II*LI + IPLI = I+LI + IF (IDRY.NE.0 .AND. II.NE.NI) + 1 CALL DRAWS (M(1,I,J),M(2,I,J),M(1,IPLI,J), + 2 M(2,IPLI,J),1,1) + IF (J.NE.MYF(1) .AND. IDRX.NE.0) + 1 CALL DRAWS (M(1,I,JPLJ),M(2,I,JPLJ),M(1,I,J), + 2 M(2,I,J),1,1) + IF (NDRZ.NE.0 .AND. II.NE.NI .AND. JJ.NE.NNYY) + 1 CALL CTCELL (Z,MMXX,NNXX,NNYY,M,MIN0(I,I+LI), + 2 MIN0(J,J+LJ)) + 400 CONTINUE + 410 CONTINUE + 420 CONTINUE + 430 IF (ISKIRT .EQ. 0) GO TO 520 +C +C FIX UP IF SKIRT IS USED WITH LINES ONE WAY. +C + IF (IDRX .NE. 0) GO TO 460 + DO 450 IPASS=1,NXPASS + IF (NXPASS .EQ. 2) IF = 1+(IPASS-1)*(NNXX-1) + DO 440 J=2,NNYY + CALL DRAWS (M(1,IF,J-1),M(2,IF,J-1),M(1,IF,J),M(2,IF,J), + 1 1,0) + 440 CONTINUE + 450 CONTINUE + 460 IF (IDRY .NE. 0) GO TO 520 + DO 480 JPASS=1,NYPASS + IF (NYPASS .EQ. 2) JF = 1+(JPASS-1)*(NNYY-1) + DO 470 I=2,NNXX + CALL DRAWS (M(1,I-1,JF),M(2,I-1,JF),M(1,I,JF),M(2,I,JF), + 1 1,0) + 470 CONTINUE + 480 CONTINUE + GO TO 520 +C +C ALL VISIBLE IF VIEWED FROM DIRECTLY ABOVE OR BELOW. +C + 490 IF (NUPPER.GT.0 .AND. S(3).LT.S(6)) GO TO 520 + IF (NUPPER.LT.0 .AND. S(3).GT.S(6)) GO TO 520 + NUPPER = 1 + IF (S(3) .LT. S(6)) NUPPER = -1 + DO 510 I=1,NNXX + DO 500 J=1,NNYY + IF (IDRX.NE.0 .AND. J.NE.NNYY) + 1 CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I,J+1),M(2,I,J+1), + 2 1,0) + IF (IDRY.NE.0 .AND. I.NE.NNXX) + 1 CALL DRAWS (M(1,I,J),M(2,I,J),M(1,I+1,J),M(2,I+1,J), + 2 1,0) + IF (IDRZ.NE.0 .AND. I.NE.NNXX .AND. J.NE.NNYY) + 1 CALL CTCELL (Z,MMXX,NNXX,NNYY,M,I,J) + 500 CONTINUE + 510 CONTINUE + 520 IF (STER .EQ. 0.) GO TO 560 + IF (ISTP) 540,530,550 + 530 CALL FRAME + 540 CALL FRAME + GO TO 570 + 550 IF (IPIC .NE. 2) GO TO 570 + 560 IF (IFR .GT. 0) CALL FRAME + 570 CONTINUE + RETURN + END + SUBROUTINE EZSRFC (Z,M,N,ANGH,ANGV,WORK) + DIMENSION Z(M,N) ,WORK(1) +C +C WORK(2*M*N+M+N) +C +C PERSPECTIVE PICTURE OF A SURFACE STORED IN A TWO DIMENSIONAL ARRAY +C VIA A VERY SHORT ARGUMENT LIST. +C +C ASSUMPTIONS-- +C THE ENTIRE ARRAY IS TO BE DRAWN, +C THE DATA IS EQUALLY SPACED (IN THE X-Y PLANE), +C NO STEREO PAIRS. +C IF THESE ASSUMPTIONS ARE NOT MET USE SRFACE. +C +C ARGUMENTS-- +C Z THE 2 DIMENSIONAL ARRAY TO BE DRAWN. +C M THE FIRST DIMENSION OF Z. +C N THE SECOND DIMENSION OF Z. +C ANGH ANGLE IN DEGREES IN THE X-Y PLANE TO THE LINE OF SIGHT +C (COUNTER-CLOCK WISE FROM THE PLUS-X AXIS). +C ANGV ANGLE IN DEGREES FROM THE X-Y PLANE TO THE LINE OF SIGHT +C (POSITIVE ANGLES ARE ABOVE THE MIDDLE Z, NEGATIVE BELOW). +C WORK A SCRATCH STORAGE DIMENSIONED AT LEAST 2*M*N+M+N. +C + COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41) ,NCL, + 1 LL ,FACT ,IROT ,NDRZ, + 2 NUPPER ,NRSWT ,BIGD ,UMIN, + 3 UMAX ,VMIN ,VMAX ,RZERO, + 4 NOFFP ,NSPVAL ,SPV ,BIGEST + DIMENSION S(6) + DATA S(4),S(5),S(6)/0.0,0.0,0.0/ +C +C FACT1 IS THE PERSPECTIVE RATIO AND IS DEFINED TO BE THE RATIO +C MAXIMUM(LENGTH,WIDTH)/HEIGHT +C +C FACT2 IS THE RATIO (LENGTH OF LINE OF SIGHT)/MAXIMUM(LENGTH,WIDTH) +C + DATA FACT1,FACT2/2.0,5.0/ + BIGEST = R1MACH(2) +C +C FIND RANGE OF Z +C + MX = M + NY = N + ANG1 = ANGH*3.14159265358979/180. + ANG2 = ANGV*3.14159265358979/180. + FLO = BIGEST + HI = -FLO + DO 20 J=1,NY + DO 10 I=1,MX + IF (NOFFP.EQ.1 .AND. Z(I,J).EQ.SPV) GO TO 10 + HI = AMAX1(Z(I,J),HI) + FLO = AMIN1(Z(I,J),FLO) + 10 CONTINUE + 20 CONTINUE +C +C SET UP LINEAR X AND Y ARRAYS FOR SRFACE +C + DELTA = (HI-FLO)/(AMAX0(MX,NY)-1.)*FACT1 + XMIN = -(FLOAT(MX/2)*DELTA+FLOAT(MOD(MX+1,2))*DELTA) + YMIN = -(FLOAT(NY/2)*DELTA+FLOAT(MOD(NY+1,2))*DELTA) + DO 30 I=1,MX + WORK(I) = XMIN+FLOAT(I-1)*DELTA + 30 CONTINUE + DO 40 J=1,NY + K = MX+J + WORK(K) = YMIN+FLOAT(J-1)*DELTA + 40 CONTINUE +C +C SET UP EYE POSITION +C + FACTE = (HI-FLO)*FACT1*FACT2 + CANG2 = COS(ANG2) + S(1) = FACTE*CANG2*COS(ANG1) + S(2) = FACTE*CANG2*SIN(ANG1) + S(3) = FACTE*SIN(ANG2)+(FLO+HI)*.5 +C +C READY +C + CALL SRFACE (WORK(1),WORK(MX+1),Z,WORK(K+1),MX,MX,NY,S,0.) + RETURN + END + SUBROUTINE SETR (XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,R0) +C +C THIS ROUTINE ESTABLISHES CERTAIN CONSTANTS SO THAT SRFACE +C PRODUCES A PICTURE WHOSE SIZE CHANGES WITH RESPECT TO THE +C VIEWERS DISTANCE FROM THE OBJECT. IT CAN ALSO BE USED +C WHEN MAKING A MOVIE OF AN OBJECT EVOLVING IN TIME TO KEEP +C IT POSITIONED PROPERLY ON THE SCREEN, SAVING COMPUTER TIME +C IN THE BARGIN. CALL IT WITH R0 NEGATIVE TO TURN OFF THIS +C FEATURE. +C PARAMETERS +C XMIN,XMAX - RANGE OF X ARRAY THAT WILL BE PASSED TO SRFACE. +C YMIN,YMAX - SAME IDEA, BUT FOR Y. +C ZMIN,ZMAX - SAME IDEA, BUT FOR Z. IF A MOVIE IS BEING +C MADE OF AN EVOLVING Z ARRAY, ZMIN AND ZMAX +C SHOULD CONTAIN RANGE OF THE UNION OF ALL THE Z +C ARRAYS. THEY NEED NOT BE EXACT. +C R0 - DISTANCE BETWEEN OBSERVER AND POINT LOOKED AT +C WHEN THE PICTURE IS TO FILL THE SCREEN WHEN +C VIEWED FROM THE DIRECTION WHICH MAKES THE PIC- +C TURE BIGGEST. IF R0 IS NOT POSITIVE, THEN THE +C RELATIVE SIZE FEATURE IS TURNED OFF, AND SUB- +C SEQUENT PICTURES WILL FILL THE SCREEN. +C + COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41) ,NCL, + 1 LL ,FACT ,IROT ,NDRZ, + 2 NUPPER ,NRSWT ,BIGD ,UMIN, + 3 UMAX ,VMIN ,VMAX ,RZERO, + 4 IOFFP ,NSPVAL ,SPVAL ,BIGEST + COMMON /PWRZ1S/ XXMIN ,XXMAX ,YYMIN ,YYMAX, + 1 ZZMIN ,ZZMAX ,DELCRT ,EYEX, + 2 EYEY ,EYEZ +C +C + CALL Q8QST4 ('GRAPHX','SRFACE','SETR','VERSION 01') + IF (R0) 10, 10, 20 + 10 NRSWT = 0 + RETURN + 20 NRSWT = 1 + XXMIN = XMIN + XXMAX = XMAX + YYMIN = YMIN + YYMAX = YMAX + ZZMIN = ZMIN + ZZMAX = ZMAX + RZERO = R0 + LL = 0 + XAT = (XXMAX+XXMIN)*.5 + YAT = (YYMAX+YYMIN)*.5 + ZAT = (ZZMAX+ZZMIN)*.5 + ALPHA = -(YYMIN-YAT)/(XXMIN-XAT) + YEYE = -RZERO/SQRT(1.+ALPHA*ALPHA) + XEYE = YEYE*ALPHA + YEYE = YEYE+YAT + XEYE = XEYE+XAT + ZEYE = ZAT + CALL TRN32S (XAT,YAT,ZAT,XEYE,YEYE,ZEYE,0) + XMN = XXMIN + XMX = XXMAX + YMN = YYMIN + YMX = YYMAX + ZMN = ZZMIN + ZMX = ZZMAX + CALL TRN32S (XMN,YMN,ZAT,UMN,DUMMY,DUMMIE,1) + CALL TRN32S (XMX,YMN,ZMN,DUMMY,VMN,DUMMIE,1) + CALL TRN32S (XMX,YMX,ZAT,UMX,DUMMY,DUMMIE,1) + CALL TRN32S (XMX,YMN,ZMX,DUMMY,VMX,DUMMIE,1) + UMIN = UMN + UMAX = UMX + VMIN = VMN + VMAX = VMX + BIGD = SQRT((XXMAX-XXMIN)**2+(YYMAX-YYMIN)**2+(ZZMAX-ZZMIN)**2)*.5 + RETURN + END + SUBROUTINE DRAWS (MX1,MY1,MX2,MY2,IDRAW,IMARK) +C +C THIS ROUTINE DRAWS THE VISIBLE PART OF THE LINE CONNECTING +C (MX1,MY1) AND (MX2,MY2). IF IDRAW .NE. 0, THE LINE IS DRAWN. +C IF IMARK .NE. 0, THE VISIBILITY ARRAY IS MARKED. +C + LOGICAL VIS1 ,VIS2 + DIMENSION PXS(2) ,PYS(2) + COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41) ,NCL, + 1 LL ,FACT ,IROT ,NDRZ, + 2 NUPPER ,NRSWT ,BIGD ,UMIN, + 3 UMAX ,VMIN ,VMAX ,RZERO, + 4 IOFFP ,NSPVAL ,SPVAL ,BIGEST + DATA STEEP/5./ + DATA MX, MY /0, 0/ +C +c +NOAO: Blockdata srfabd rewritten as run time initialization +c EXTERNAL SRFABD + call srfabd +c -NOAO +C MAKE LINE LEFT TO RIGHT. +C + MMX1 = MX1 + MMY1 = MY1 + MMX2 = MX2 + MMY2 = MY2 + IF (MMX1.EQ.NSPVAL .OR. MMX2.EQ.NSPVAL) RETURN + IF (MMX1 .GT. MMX2) GO TO 10 + NX1 = MMX1 + NY1 = MMY1 + NX2 = MMX2 + NY2 = MMY2 + GO TO 20 + 10 NX1 = MMX2 + NY1 = MMY2 + NX2 = MMX1 + NY2 = MMY1 + 20 IF (NUPPER .LT. 0) GO TO 180 +C +C CHECK UPPER VISIBILITY. +C + VIS1 = NY1 .GE. (LIMU(NX1)-1) + VIS2 = NY2 .GE. (LIMU(NX2)-1) +C +C VIS1 AND VIS2 TRUE MEANS VISIBLE. +C + IF (VIS1 .AND. VIS2) GO TO 120 +C +C VIS1 AND VIS2 FALSE MEANS INVISIBLE. +C + IF (.NOT.(VIS1 .OR. VIS2)) GO TO 180 +C +C FIND CHANGE POINT. +C + IF (NX1 .EQ. NX2) GO TO 110 + DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1) + NX1P1 = NX1+1 + FNY1 = NY1 + IF (VIS1) GO TO 60 + DO 30 K=NX1P1,NX2 + MX = K + MY = FNY1+FLOAT(K-NX1)*DY + IF (MY .GT. LIMU(K)) GO TO 40 + 30 CONTINUE + 40 IF (ABS(DY) .GE. STEEP) GO TO 90 + 50 NX1 = MX + NY1 = MY + GO TO 120 + 60 DO 70 K=NX1P1,NX2 + MX = K + MY = FNY1+FLOAT(K-NX1)*DY + IF (MY .LT. LIMU(K)) GO TO 80 + 70 CONTINUE + 80 IF (ABS(DY) .GE. STEEP) GO TO 100 + NX2 = MX-1 + NY2 = MY + GO TO 120 + 90 IF (LIMU(MX) .EQ. 0) GO TO 50 + NX1 = MX + NY1 = LIMU(NX1) + GO TO 120 + 100 NX2 = MX-1 + NY2 = LIMU(NX2) + GO TO 120 + 110 IF (VIS1) NY2 = MIN0(LIMU(NX1),LIMU(NX2)) + IF (VIS2) NY1 = MIN0(LIMU(NX1),LIMU(NX2)) + 120 IF (IDRAW .EQ. 0) GO TO 150 +C +C DRAW VISIBLE PART OF LINE. +C + IF (IROT) 130,140,130 + 130 CONTINUE + PXS(1) = FLOAT(NY1) + PXS(2) = FLOAT(NY2) + PYS(1) = FLOAT(1024-NX1) + PYS(2) = FLOAT(1024-NX2) + CALL GPL (2,PXS,PYS) + GO TO 150 + 140 CONTINUE + PXS(1) = FLOAT(NX1) + PXS(2) = FLOAT(NX2) + PYS(1) = FLOAT(NY1) + PYS(2) = FLOAT(NY2) + CALL GPL (2,PXS,PYS) + 150 IF (IMARK .EQ. 0) GO TO 180 + IF (NX1 .EQ. NX2) GO TO 170 + DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1) + FNY1 = NY1 + DO 160 K=NX1,NX2 + LTEMP = FNY1+FLOAT(K-NX1)*DY + IF (LTEMP .GT. LIMU(K)) LIMU(K) = LTEMP + 160 CONTINUE + GO TO 180 + 170 LTEMP = MAX0(NY1,NY2) + IF (LTEMP .GT. LIMU(NX1)) LIMU(NX1) = LTEMP + 180 IF (NUPPER) 190,190,370 +C +C SAME IDEA AS ABOVE, BUT FOR LOWER SIDE. +C + 190 IF (MMX1 .GT. MMX2) GO TO 200 + NX1 = MMX1 + NY1 = MMY1 + NX2 = MMX2 + NY2 = MMY2 + GO TO 210 + 200 NX1 = MMX2 + NY1 = MMY2 + NX2 = MMX1 + NY2 = MMY1 + 210 VIS1 = NY1 .LE. (LIML(NX1)+1) + VIS2 = NY2 .LE. (LIML(NX2)+1) + IF (VIS1 .AND. VIS2) GO TO 310 + IF (.NOT.(VIS1 .OR. VIS2)) GO TO 370 + IF (NX1 .EQ. NX2) GO TO 300 + DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1) + NX1P1 = NX1+1 + FNY1 = NY1 + IF (VIS1) GO TO 250 + DO 220 K=NX1P1,NX2 + MX = K + MY = FNY1+FLOAT(K-NX1)*DY + IF (MY .LT. LIML(K)) GO TO 230 + 220 CONTINUE + 230 IF (ABS(DY) .GE. STEEP) GO TO 280 + 240 NX1 = MX + NY1 = MY + GO TO 310 + 250 DO 260 K=NX1P1,NX2 + MX = K + MY = FNY1+FLOAT(K-NX1)*DY + IF (MY .GT. LIML(K)) GO TO 270 + 260 CONTINUE + 270 IF (ABS(DY) .GE. STEEP) GO TO 290 + NX2 = MX-1 + NY2 = MY + GO TO 310 + 280 IF (LIML(MX) .EQ. 1024) GO TO 240 + NX1 = MX + NY1 = LIML(NX1) + GO TO 310 + 290 NX2 = MX-1 + NY2 = LIML(NX2) + GO TO 310 + 300 IF (VIS1) NY2 = MAX0(LIML(NX1),LIML(NX2)) + IF (VIS2) NY1 = MAX0(LIML(NX1),LIML(NX2)) + 310 IF (IDRAW .EQ. 0) GO TO 340 + IF (IROT) 320,330,320 + 320 CONTINUE + PXS(1) = FLOAT(NY1) + PXS(2) = FLOAT(NY2) + PYS(1) = FLOAT(1024-NX1) + PYS(2) = FLOAT(1024-NX2) + CALL GPL (2,PXS,PYS) + GO TO 340 + 330 CONTINUE + PXS(1) = FLOAT(NX1) + PXS(2) = FLOAT(NX2) + PYS(1) = FLOAT(NY1) + PYS(2) = FLOAT(NY2) + CALL GPL (2,PXS,PYS) + 340 IF (IMARK .EQ. 0) GO TO 370 + IF (NX1 .EQ. NX2) GO TO 360 + DY = FLOAT(NY2-NY1)/FLOAT(NX2-NX1) + FNY1 = NY1 + DO 350 K=NX1,NX2 + LTEMP = FNY1+FLOAT(K-NX1)*DY + IF (LTEMP .LT. LIML(K)) LIML(K) = LTEMP + 350 CONTINUE + RETURN + 360 LTEMP = MIN0(NY1,NY2) + IF (LTEMP .LT. LIML(NX1)) LIML(NX1) = LTEMP + 370 RETURN + END + SUBROUTINE TRN32S (X,Y,Z,XT,YT,ZT,IFLAG) +C +C THIS ROUTINE IMPLEMENTS THE 3-SPACE TO 2-SPACE TRANSFOR- +C MATION BY KUBER, SZABO AND GIULIERI, THE PERSPECTIVE +C REPRESENTATION OF FUNCTIONS OF TWO VARIABLES. J. ACM 15, +C 2, 193-204,1968. +C IFLAG=0 ARGUMENTS +C X,Y,Z ARE THE 3-SPACE COORDINATES OF THE INTERSECTION +C OF THE LINE OF SIGHT AND THE IMAGE PLANE. THIS +C POINT CAN BE THOUGHT OF AS THE POINT LOOKED AT. +C XT,YT,ZT ARE THE 3-SPACE COORDINATES OF THE EYE POSITION. +C +C IFLAG=1 ARGUMENTS +C X,Y,Z ARE THE 3-SPACE COORDINATES OF A POINT TO BE +C TRANSFORMED. +C XT,YT THE RESULTS OF THE 3-SPACE TO 2-SPACE TRANSFOR- +C MATION. +C USE IFIX(XT) AND IFIX(YT) IN GPL CALLS. +C ZT NOT USED. +C IF LL (IN COMMON) =0 XT AND YT ARE IN THE SAME SCALE AS X, Y, AND Z. +C + COMMON /PWRZ1S/ XXMIN ,XXMAX ,YYMIN ,YYMAX, + 1 ZZMIN ,ZZMAX ,DELCRT ,EYEX, + 2 EYEY ,EYEZ + COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41) ,NCL, + 1 LL ,FACT ,IROT ,NDRZ, + 2 NUPPER ,NRSWT ,BIGD ,UMIN, + 3 UMAX ,VMIN ,VMAX ,RZERO, + 4 IOFFP ,NSPVAL ,SPVAL ,BIGEST + DIMENSION NLU(7) ,NRU(7) ,NBV(7) ,NTV(7) +C +C SAVE INSERTED BY BEN DOMENICO 9/8/85 BECAUSE OF ASSUMPTION THAT +C JUMP, JUMP2, AND JUMP3 ARE PRESERVED BETWEEN CALLS. +C THERE MAY BE OTHER SUCH ASSUMPTIONS AS WELL. +C + SAVE +C +C PICTURE CORNER COORDINATES FOR LL=1 +C + DATA NLU(1),NRU(1),NBV(1),NTV(1)/ 10,1014, 10,1014/ +C +C PICTURE CORNER COORDINATES FOR LL=2 +C + DATA NLU(2),NRU(2),NBV(2),NTV(2)/ 10, 924, 50, 964/ +C +C PICTURE CORNER COORDINATES FOR LL=3 +C + DATA NLU(3),NRU(3),NBV(3),NTV(3)/ 100,1014, 50, 964/ +C +C PICTURE CORNER COORDINATES FOR LL=4 +C + DATA NLU(4),NRU(4),NBV(4),NTV(4)/ 10,1014, 10,1014/ +C +C PICTURE CORNER COORDINATES FOR LL=5 +C + DATA NLU(5),NRU(5),NBV(5),NTV(5)/ 10,1014, 10,1014/ +C +C PICTURE CORNER COORDINATES FOR LL=6 +C + DATA NLU(6),NRU(6),NBV(6),NTV(6)/ 10, 512, 256, 758/ +C +C PICTURE CORNER COORDINATES FOR LL=7 +C + DATA NLU(7),NRU(7),NBV(7),NTV(7)/ 512,1014, 256, 758/ +C +C STORE THE PARAMETERS OF THE SET32 CALL FOR USE WHEN +C TRN32 IS CALLED. +C + IF (IFLAG) 40, 10, 40 + 10 CONTINUE + ASSIGN 60 TO JUMP3 + IF (IOFFP .EQ. 1) ASSIGN 50 TO JUMP3 + AX = X + AY = Y + AZ = Z + EX = XT + EY = YT + EZ = ZT +C +C AS MUCH COMPUTATION AS POSSIBLE IS DONE DURING EXECUTION +C THIS ROUTINE WHEN IFLAG=0 BECAUSE CALLS IN THAT MODE ARE INFREQUENT. +C + DX = AX-EX + DY = AY-EY + DZ = AZ-EZ + D = SQRT(DX*DX+DY*DY+DZ*DZ) + COSAL = DX/D + COSBE = DY/D + COSGA = DZ/D + SINGA = SQRT(1.-COSGA*COSGA) + ASSIGN 120 TO JUMP2 + IF (LL .EQ. 0) GO TO 20 + ASSIGN 100 TO JUMP2 + DELCRT = NRU(LL)-NLU(LL) + U0 = UMIN + V0 = VMIN + U1 = NLU(LL) + V1 = NBV(LL) + U2 = NRU(LL)-NLU(LL) + V2 = NTV(LL)-NBV(LL) + U3 = U2/(UMAX-UMIN) + V3 = V2/(VMAX-VMIN) + U4 = NRU(LL) + V4 = NTV(LL) + IF (NRSWT .EQ. 0) GO TO 20 + U0 = -BIGD + V0 = -BIGD + U3 = U2/(2.*BIGD) + V3 = V2/(2.*BIGD) +C +C THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF +C THE 2-SPACE. THE 3-SPACE Z AXIS IS TRANSFORMED INTO THE +C 2-SPACE Y AXIS. IF THE LINE OF SIGHT IS CLOSE TO PARALLEL +C TO THE 3-SPACE Z AXIS, THE 3-SPACE Y AXIS IS CHOSEN (IN- +C STEAD OF THE 3-SPACE Z AXIS) TO BE TRANSFORMED INTO THE +C 2-SPACE Y AXIS. +C + 20 IF (SINGA .LT. 0.0001) GO TO 30 + R = 1./SINGA + ASSIGN 70 TO JUMP + RETURN + 30 SINBE = SQRT(1.-COSBE*COSBE) + R = 1./SINBE + ASSIGN 80 TO JUMP + RETURN + 40 CONTINUE + XX = X + YY = Y + ZZ = Z + GO TO JUMP3,( 50, 60) + 50 IF (ZZ .EQ. SPVAL) GO TO 110 + 60 Q = D/((XX-EX)*COSAL+(YY-EY)*COSBE+(ZZ-EZ)*COSGA) + GO TO JUMP,( 70, 80) + 70 XX = ((EX+Q*(XX-EX)-AX)*COSBE-(EY+Q*(YY-EY)-AY)*COSAL)*R + YY = (EZ+Q*(ZZ-EZ)-AZ)*R + GO TO 90 + 80 XX = ((EZ+Q*(ZZ-EZ)-AZ)*COSAL-(EX+Q*(XX-EX)-AX)*COSGA)*R + YY = (EY+Q*(YY-EY)-AY)*R + 90 GO TO JUMP2,(100,120) +c + NOAO: Clipping is done at the gio level and is unnecessary here. The +c following statements were preventing labels from being positioned properly +c at the edges of the surface plot, even when the viewport had been reset. + 100 xx = u1 + u3 * (fact * xx - u0) + yy = v1 + v3 * (fact * yy - v0) +c 100 XX = AMIN1(U4,AMAX1(U1,U1+U3*(FACT*XX-U0))) +c YY = AMIN1(V4,AMAX1(V1,V1+V3*(FACT*YY-V0))) +c -NOAO + GO TO 120 + 110 XX = NSPVAL + YY = NSPVAL +C + 120 XT = XX + YT = YY + RETURN + END + SUBROUTINE CLSET (Z,MX,NX,NY,CHI,CLO,CINC,NLA,NLM,CL,NCL,ICNST, + 1 IOFFP,SPVAL,BIGEST) + DIMENSION Z(MX,NY) ,CL(NLM) + DATA KK /0/ +C +C CLSET PUTS THE VALUS OF THE CONTOUR LEVELS IN CL +C + ICNST = 0 + GLO = CLO + HA = CHI + FANC = CINC + CRAT = NLA + IF (HA-GLO) 10, 20, 50 + 10 GLO = HA + HA = CLO + GO TO 50 + 20 GLO = BIGEST + HA = -GLO + DO 40 J=1,NY + DO 30 I=1,NX + IF (IOFFP.EQ.1 .AND. Z(I,J).EQ.SPVAL) GO TO 30 + GLO = AMIN1(Z(I,J),GLO) + HA = AMAX1(Z(I,J),HA) + 30 CONTINUE + 40 CONTINUE + 50 IF (FANC) 60, 70, 90 + 60 CRAT = -FANC + 70 FANC = (HA-GLO)/CRAT + IF (FANC) 140,140, 80 + 80 P = 10.**(IFIX(ALOG10(FANC)+500.)-500) + FANC = AINT(FANC/P)*P + 90 IF (CHI-CLO) 110,100,110 + 100 GLO = AINT(GLO/FANC)*FANC + HA = AINT(HA/FANC)*FANC + 110 DO 120 K=1,NLM + CC = GLO+FLOAT(K-1)*FANC + IF (CC .GT. HA) GO TO 130 + KK = K + CL(K) = CC + 120 CONTINUE + 130 NCL = KK + RETURN + 140 ICNST = 1 + RETURN + END + SUBROUTINE CTCELL (Z,MX,NX,NY,M,I0,J0) +C +C CTCELL COMPUTES LINES OF CONSTANT Z (CONTOUR LINES) IN ONE +C CELL OF THE ARRAY Z FOR THE SRFACE PACKAGE. +C Z,MX,NX,NY ARE THE SAME AS IN SRFACE. +C M BY THE TIME CTCELL IS FIRST CALLED, M CONTAINS +C THE TWO-SPACE PLOTTER LOCATION OF EACH Z POINT. +C U(Z(I,J))=M(1,I,J). V(Z(I,J))=M(2,I,J) +C I0,J0 THE CELL Z(I0,J0) TO Z(I0+1,J0+1) IS THE ONE TO +C BE CONTOURED. +C + DIMENSION Z(MX,NY) ,M(2,NX,NY) + COMMON /SRFBLK/ LIMU(1024) ,LIML(1024) ,CL(41) ,NCL, + 1 LL ,FACT ,IROT ,NDRZ, + 2 NUPPER ,NRSWT ,BIGD ,UMIN, + 3 UMAX ,VMIN ,VMAX ,RZERO, + 4 IOFFP ,NSPVAL ,SPVAL ,BIGEST + DATA IDUB/0/ + R(HO,HU) = (HO-CV)/(HO-HU) + I1 = I0 + I1P1 = I1+1 + J1 = J0 + J1P1 = J1+1 + H1 = Z(I1,J1) + H2 = Z(I1,J1P1) + H3 = Z(I1P1,J1P1) + H4 = Z(I1P1,J1) + IF (IOFFP .NE. 1) GO TO 10 + IF (H1.EQ.SPVAL .OR. H2.EQ.SPVAL .OR. H3.EQ.SPVAL .OR. + 1 H4.EQ.SPVAL) RETURN + 10 IF (AMIN1(H1,H2,H3,H4) .GT. CL(NCL)) RETURN + DO 110 K=1,NCL +C +C FOR EACH CONTOUR LEVEL, DESIDE WHICH OF THE 16 BASIC SIT- +C UATIONS EXISTS, THEN INTERPOLATE IN TWO-SPACE TO FIND THE +C END POINTS OF THE CONTOUR LINE SEGMENT WITHIN THIS CELL. +C + CV = CL(K) + K1 = (IFIX(SIGN(1.,H1-CV))+1)/2 + K2 = (IFIX(SIGN(1.,H2-CV))+1)/2 + K3 = (IFIX(SIGN(1.,H3-CV))+1)/2 + K4 = (IFIX(SIGN(1.,H4-CV))+1)/2 + JUMP = 1+K1+K2*2+K3*4+K4*8 + GO TO (120, 30, 50, 60, 70, 20, 80, 90, 90, 80, + 1 40, 70, 60, 50, 30,110),JUMP + 20 IDUB = 1 + 30 RA = R(H1,H2) + MUA = FLOAT(M(1,I1,J1))+RA*FLOAT(M(1,I1,J1P1)-M(1,I1,J1)) + MVA = FLOAT(M(2,I1,J1))+RA*FLOAT(M(2,I1,J1P1)-M(2,I1,J1)) + RB = R(H1,H4) + MUB = FLOAT(M(1,I1,J1))+RB*FLOAT(M(1,I1P1,J1)-M(1,I1,J1)) + MVB = FLOAT(M(2,I1,J1))+RB*FLOAT(M(2,I1P1,J1)-M(2,I1,J1)) + GO TO 100 + 40 IDUB = -1 + 50 RA = R(H2,H1) + MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1,J1)-M(1,I1,J1P1)) + MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1,J1)-M(2,I1,J1P1)) + RB = R(H2,H3) + MUB = FLOAT(M(1,I1,J1P1))+RB*FLOAT(M(1,I1P1,J1P1)-M(1,I1,J1P1)) + MVB = FLOAT(M(2,I1,J1P1))+RB*FLOAT(M(2,I1P1,J1P1)-M(2,I1,J1P1)) + GO TO 100 + 60 RA = R(H2,H3) + MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1P1,J1P1)-M(1,I1,J1P1)) + MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1P1,J1P1)-M(2,I1,J1P1)) + RB = R(H1,H4) + MUB = FLOAT(M(1,I1,J1))+RB*FLOAT(M(1,I1P1,J1)-M(1,I1,J1)) + MVB = FLOAT(M(2,I1,J1))+RB*FLOAT(M(2,I1P1,J1)-M(2,I1,J1)) + GO TO 100 + 70 RA = R(H3,H2) + MUA = FLOAT(M(1,I1P1,J1P1))+ + 1 RA*FLOAT(M(1,I1,J1P1)-M(1,I1P1,J1P1)) + MVA = FLOAT(M(2,I1P1,J1P1))+ + 1 RA*FLOAT(M(2,I1,J1P1)-M(2,I1P1,J1P1)) + RB = R(H3,H4) + MUB = FLOAT(M(1,I1P1,J1P1))+ + 1 RB*FLOAT(M(1,I1P1,J1)-M(1,I1P1,J1P1)) + MVB = FLOAT(M(2,I1P1,J1P1))+ + 1 RB*FLOAT(M(2,I1P1,J1)-M(2,I1P1,J1P1)) + IDUB = 0 + GO TO 100 + 80 RA = R(H2,H1) + MUA = FLOAT(M(1,I1,J1P1))+RA*FLOAT(M(1,I1,J1)-M(1,I1,J1P1)) + MVA = FLOAT(M(2,I1,J1P1))+RA*FLOAT(M(2,I1,J1)-M(2,I1,J1P1)) + RB = R(H3,H4) + MUB = FLOAT(M(1,I1P1,J1P1))+ + 1 RB*FLOAT(M(1,I1P1,J1)-M(1,I1P1,J1P1)) + MVB = FLOAT(M(2,I1P1,J1P1))+ + 1 RB*FLOAT(M(2,I1P1,J1)-M(2,I1P1,J1P1)) + GO TO 100 + 90 RA = R(H4,H1) + MUA = FLOAT(M(1,I1P1,J1))+RA*FLOAT(M(1,I1,J1)-M(1,I1P1,J1)) + MVA = FLOAT(M(2,I1P1,J1))+RA*FLOAT(M(2,I1,J1)-M(2,I1P1,J1)) + RB = R(H4,H3) + MUB = FLOAT(M(1,I1P1,J1))+RB*FLOAT(M(1,I1P1,J1P1)-M(1,I1P1,J1)) + MVB = FLOAT(M(2,I1P1,J1))+RB*FLOAT(M(2,I1P1,J1P1)-M(2,I1P1,J1)) + IDUB = 0 + 100 CALL DRAWS (MUA,MVA,MUB,MVB,1,0) + IF (IDUB) 90,110, 70 + 110 CONTINUE + 120 RETURN + END |