/usr/share/ncarg/tests/tcolcv.f is in libncarg-data 6.3.0-6build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | PROGRAM TCOLCV
CALL COLCV(IERR)
C
STOP
END
C
SUBROUTINE COLCV (IERR)
C
C PURPOSE To provide a demonstration of the routines in
C the package COLCONV and to test them.
C
C USAGE CALL COLCV (IERR)
C
C ARGUMENTS
C
C ON OUTPUT IERR
C An integer variable
C = 0, if the test is successful,
C = 1, otherwise
C
C I/O If the test is successful, the message
C
C COLCONV TEST SUCCESSFUL
C
C is written on unit 6.
C
C Otherwise, the message
C
C COLCONV TEST SUCCESSFUL
C
C is written on unit 6.
C
C PRECISION Single
C
C REQUIRED PACKAGES COLCONV
C
C REQUIRED GKS LEVEL NONE
C
C LANGUAGE FORTRAN
C
C ALGORITHM TCOLCV executes six calls to test each of
C the color conversions:
C
C HLS to RGB
C RGB to HLS
C HSV to RGB
C RGB to HSV
C YIQ to RGB
C RGB to YIQ
C
C ---------------------------------------------------------------------
C
C Initialize the error flag.
C
IERR = 0
C
C Set tolerance limit for HLS and HSV tests.
C
EPS = 0.00001
C
C HLS to RGB.
C
CALL HLSRGB(120.,50.,100.,R,G,B)
IF ( (ABS(R-1.) .GT. EPS) .OR. (ABS(G) .GT. EPS) .OR.
* (ABS(B) .GT. EPS) ) IERR = 1
C
C RGB to HLS.
C
CALL RGBHLS(1.,0.,0.,H,FL,S)
IF ( (ABS(H-120.) .GT. EPS) .OR. (ABS(FL-50.) .GT. EPS) .OR.
* (ABS(S-100.) .GT. EPS) ) IERR = 1
C
C HSV to RGB.
C
CALL HSVRGB(120.,1.,1.,R,G,B)
IF ( (ABS(R-0.) .GT. EPS) .OR. (ABS(G-1.) .GT. EPS) .OR.
* (ABS(B-0.) .GT. EPS) ) IERR = 1
C
C RGB to HSV.
C
CALL RGBHSV(0.,0.,1.,H,S,V)
IF ( (ABS(H-240.) .GT. EPS) .OR. (ABS(S-1.) .GT. EPS) .OR.
* (ABS(V-1.) .GT. EPS) ) IERR = 1
C
C Set tolerance limit for YIQ tests.
C
EPS = 0.01
C
C YIQ to RGB.
C
CALL YIQRGB(0.58701, -0.27431, -0.52299,R,G,B)
IF ( (ABS(R-0.) .GT. EPS) .OR. (ABS(G-1.) .GT. EPS) .OR.
* (ABS(B-0.) .GT. EPS) ) IERR = 1
C
C RGB to YIQ.
C
CALL RGBYIQ(1.,1.,1.,Y,FI,Q)
IF ( (ABS(Y-1.) .GT. EPS) .OR. (ABS(FI) .GT. EPS) .OR.
* (ABS(Q) .GT. EPS) ) IERR = 1
C
IF (IERR .EQ. 0) THEN
WRITE (6,1001)
ELSE
WRITE (6,1002)
ENDIF
C
RETURN
C
1001 FORMAT (' COLCONV TEST SUCCESSFUL')
1002 FORMAT (' COLCONV TEST UNSUCCESSFUL')
END
|