home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / utilities / utilsp / pgplot / Examples / f77 / PGDemo4 < prev    next >
Encoding:
Text File  |  1994-02-24  |  4.1 KB  |  145 lines
  1.       PROGRAM PGDEM4
  2. C-----------------------------------------------------------------------
  3. C Test program for PGPLOT: test of imaging routine PGGRAY (with 
  4. C PGCONT). This program serves to both demonstrate and test PGGRAY.
  5. C It computes an (arbitrary) function on a 2D array, and uses both
  6. C PGGRAY and PGCONT to display it. An irregular transformation (TR 
  7. C matrix) is used, to test (a) that the routine works when the array
  8. C pixels are not aligned with the device pixels, and (b) that the
  9. C image is clipped correctly at the edge of the viewport. The program
  10. C also draws the bounding quadrilateral of the contour map. The contours
  11. C should end on this quadrilateral, but note that the grayscale image 
  12. C extends one half pixel beyond this quadrilateral (if the subarray to 
  13. C be displayed contains N pixels in one dimension, the width of the
  14. C image is N units, while the width of the contour map is N-1 pixels).
  15. C-----------------------------------------------------------------------
  16.       INTEGER PGBEG
  17.       INTEGER   MXI, MXJ
  18.       PARAMETER (MXI=40, MXJ=40)
  19.       INTEGER I,J
  20.       REAL F(MXI,MXJ)
  21.       REAL ANGLE,FMIN,FMAX,ALEV,RADIUS,TR(6),BLACK,WHITE
  22. C
  23. C ANGLE is the image rotation angle in radians.
  24. C
  25.       ANGLE=-135./57.29578
  26. C
  27. C Open device for graphics.
  28. C
  29.       IF (PGBEG(0,'?',2,1) .NE. 1) STOP
  30. C
  31. C Compute a suitable function.
  32. C
  33.       FMIN = F(1,1)
  34.       FMAX = F(1,1)
  35.       DO 20 I=1,MXI
  36.           DO 10 J=1,MXJ
  37.               F(I,J) = COS(0.6*SQRT(I*80./MXI)-16.0*J/(3.*MXJ))*
  38.      :                 COS(16.0*I/(3.*MXI))+(I/FLOAT(MXI)-J/FLOAT(MXJ))
  39.               FMIN = MIN(F(I,J),FMIN)
  40.               FMAX = MAX(F(I,J),FMAX)
  41.    10     CONTINUE
  42.    20 CONTINUE
  43. C
  44. C (1) Test PGGRAY
  45. C Clear the screen. Set up window and viewport.
  46. C
  47.       CALL PGPAGE
  48.       CALL PGSVP(0.05,0.95,0.05,0.95)
  49.       CALL PGWNAD(-40., 40.,-40., 40.)
  50.       CALL PGSCI(5)
  51.       CALL PGMTXT('t',1.0,0.0,0.0,'Test of PGGRAY')
  52.       CALL PGSCI(1)
  53. C
  54. C Draw the map.  
  55. C
  56.       BLACK = FMIN
  57.       WHITE = FMAX
  58.       RADIUS= 40.*SQRT(2.)
  59.       TR(1) =-(40./MXI)*COS(ANGLE)+(40./MXJ)*SIN(ANGLE)-
  60.      :         RADIUS*COS(ANGLE+45/57.29578)
  61.       TR(2) = 80.*COS(ANGLE)/MXI
  62.       TR(3) =-80.*SIN(ANGLE)/MXJ
  63.       TR(4) =-(40./MXI)*SIN(ANGLE)-(40./MXJ)*COS(ANGLE)-
  64.      :         RADIUS*SIN(ANGLE+45/57.29578)
  65.       TR(5) = 80.*SIN(ANGLE)/MXI
  66.       TR(6) = 80.*COS(ANGLE)/MXJ
  67.       CALL PGGRAY(F,MXI,MXJ,1,MXI,1,MXJ,BLACK,WHITE,TR)
  68.       CALL PGSCI(2)
  69.       CALL OUTLIN(1,MXI,1,MXJ,TR)
  70.       CALL PGSCI(5)
  71.       CALL PGBOX('bcnts',0.0,0,'bcnts',0.0,0)
  72. C
  73. C Draw a wedge.
  74. C
  75.       CALL PGWEDG('B', 3.0, 4.0, BLACK, WHITE, ' ')
  76. C
  77. C (2) Test PGCONT
  78. C Clear the screen. Set up window and viewport.
  79. C
  80.       CALL PGPAGE
  81.       CALL PGSVP(0.05,0.95,0.05,0.95)
  82.       CALL PGWNAD(-40., 40.,-40., 40.)
  83.       CALL PGSCI(5)
  84.       CALL PGMTXT('t',1.0,0.0,0.0,'Test of PGCONT')
  85.       CALL PGSCI(1)
  86. C
  87. C Draw the map.  
  88. C
  89.       DO 30 I=1,21
  90.           ALEV = FMIN + (I-1)*(FMAX-FMIN)/20.0
  91.           IF (MOD(I,5).EQ.0) THEN
  92.               CALL PGSLW(3)
  93.           ELSE
  94.               CALL PGSLW(1)
  95.           END IF
  96.           IF (I.LT.10) THEN
  97.               CALL PGSLS(2)
  98.           ELSE
  99.               CALL PGSLS(1)
  100.           END IF
  101.           CALL PGCONT(F,MXI,MXJ,1,MXI,1,MXJ,ALEV,-1,TR)
  102.    30 CONTINUE
  103.       CALL PGSLS(1)
  104.       CALL PGSLW(1)
  105.       CALL PGSCI(2)
  106.       CALL OUTLIN(1,MXI,1,MXJ,TR)
  107.       CALL PGSCI(5)
  108.       CALL PGBOX('bcnts',0.0,0,'bcnts',0.0,0)
  109. C
  110. C Close the device and exit.
  111. C
  112.       CALL PGEND
  113.       END
  114.  
  115.       SUBROUTINE OUTLIN(I1,I2,J1,J2,TR)
  116.       INTEGER I1,I2,J1,J2
  117.       REAL TR(6)
  118. C
  119. C Draw the enclosing rectangle of the subarray to be contoured,
  120. C applying the transformation TR.
  121. C
  122. C For a contour map, the corners are (I1,J1) and (I2,J2); for
  123. C a gray-scale map, they are (I1-0.5,J1-0.5), (I2+0.5, J2+0.5).
  124. C
  125.       INTEGER K
  126.       REAL XW(5), YW(5), T
  127. C
  128.       XW(1) = I1
  129.       YW(1) = J1
  130.       XW(2) = I1
  131.       YW(2) = J2
  132.       XW(3) = I2
  133.       YW(3) = J2
  134.       XW(4) = I2
  135.       YW(4) = J1
  136.       XW(5) = I1
  137.       YW(5) = J1
  138.       DO 10 K=1,5
  139.           T = XW(K)
  140.           XW(K) = TR(1) + TR(2)*T + TR(3)*YW(K)
  141.           YW(K) = TR(4) + TR(5)*T + TR(6)*YW(K)
  142.    10 CONTINUE
  143.       CALL PGLINE(5,XW,YW)
  144.       END
  145.