/usr/share/ncarg/tests/tcnsmt.f is in libncarg-data 6.1.2-7.
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 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | PROGRAM TCNSMT
C
C Define the error file, the Fortran unit number, the workstation type,
C and the workstation ID to be used in calls to GKS routines.
C
C PARAMETER (IERRF=6, LUNIT=2, IWTYPE=1, IWKID=1) ! NCGM
C PARAMETER (IERRF=6, LUNIT=2, IWTYPE=8, IWKID=1) ! X Windows
C PARAMETER (IERRF=6, LUNIT=2, IWTYPE=11, IWKID=1) ! PDF
C PARAMETER (IERRF=6, LUNIT=2, IWTYPE=20, IWKID=1) ! PostScript
C
PARAMETER (IERRF=6, LUNIT=2, IWTYPE=1, IWKID=1)
C
C OPEN GKS, OPEN WORKSTATION OF TYPE 1, ACTIVATE WORKSTATION
C
CALL GOPKS (IERRF, ISZDM)
CALL GOPWK (IWKID, LUNIT, IWTYPE)
CALL GACWK (IWKID)
C
C INVOKE DEMO DRIVER
C
CALL CNSMT(IERR)
C
C DEACTIVATE AND CLOSE WORKSTATION, CLOSE GKS.
C
CALL GDAWK (IWKID)
CALL GCLWK (IWKID)
CALL GCLKS
C
STOP
END
C
SUBROUTINE CNSMT (IERROR)
C
C PURPOSE To provide a simple demonstration of
C the CONRECSMTH package.
C
C USAGE CALL CNSMT (IERROR)
C
C ARGUMENTS
C
C ON OUTPUT IERROR
C An integer variable
C = 0, if the test was successful,
C = 1, otherwise
C
C I/O If the test is successful, the message
C
C CONREC SMOOTH TEST EXECUTED--SEE PLOTS TO CERTIFY
C
C is printed on unit 6. In addition, 2
C frames are produced on the machine graphics
C device. In order to determine if the test
C was successful, it is necessary to examine
C the plots.
C
C PRECISION Single
C
C LANGUAGE FORTRAN 77
C
C REQUIRED ROUTINES CONREC, DASHSMTH
C
C REQUIRED GKS LEVEL 0A
C
C ALGORITHM The function
C
C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09)
C -1./((X+.1)**2+Y**2+.09)
C
C for X = -1. to +1. in increments of .1, and
C Y = -1.2 to +1.2 in increments of .1,
C is computed. Then, entries EZCNTR and CONREC
C are called to generate contour plots of Z.
C
C This is a smoothed curve version of the CONREC
C family of utilities.
C
C
C Z contains the values to be plotted.
C
REAL Z(21,25)
C
C Define the center of a plot title string on a square grid of size
C 0. to 1.
C
DATA TX/.4267/, TY/.9765/
C
C
C Initialize the error parameter.
C
IERROR = 0
C
C Fill a 2-D array to be plotted.
C
DO 20 I=1,21
X = .1*REAL(I-11)
DO 10 J=1,25
Y = .1*REAL(J-13)
Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
1 1./((X+.10)**2+Y**2+.09)
10 CONTINUE
20 CONTINUE
C
C Select normalization transformation number 0.
C
CALL GSELNT (0)
C
C
C Frame 1 -- EZCNTR entry of CONRECSMTH.
C
C Entry EZCNTR requires only the array name and dimensions.
C
CALL PLCHLQ (TX, TY,
1 'DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSMTH',16.,0.,0.)
CALL EZCNTR (Z,21,25)
C
C
C Frame 2 -- CONREC entry of CONRECSMTH.
C
C Entry CONREC allows user definition of various plot parameters.
C
C In this example, the lowest contour level (-4.5), the highest contour
C level (4.5), and the increment between contour levels (0.3) are set.
C
CALL PLCHLQ (TX,TY,
1 'DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSMTH',
2 16.,0.,0.)
CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0)
CALL FRAME
C
WRITE (6,1001)
RETURN
C
1001 FORMAT (' CONREC SMOOTH TEST EXECUTED--SEE PLOTS TO CERTIFY')
END
|