/usr/share/ncarg/tests/tconas.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 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | PROGRAM TCONAS
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 CONAS(IERR)
C
C DEACTIVATE AND CLOSE WORKSTATION, CLOSE GKS.
C
CALL GDAWK (IWKID)
CALL GCLWK (IWKID)
CALL GCLKS
C
STOP
END
C
SUBROUTINE CONAS (IERROR)
C
C PURPOSE To provide a simple demonstration of
C CONRAS, the super entry of the CONRAN
C package.
C
C USAGE CALL CONAS (IERROR)
C
C ARGUMENTS
C
C ON OUTPUT IERROR
C An integer variable
C = 0, if the test was successful,
C > 0, the test was not successful,
C and the error number corresponds
C to the number in the CONRAS listing.
C
C I/O If the test is successful, the message
C
C CONRAS 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. The first plot is the contour plot.
C The second plot shows the triangulation of the
C data. 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 CONRAS, CONTERP, CONCOM, DASHSUPR
C
C REQUIRED GKS LEVEL 0A
C
C ALGORITHM A sparse dataset is defined in DATA statements.
C Options are selected to produce a plot title
C and display the triangulation generated by the
C interpolation routines. Default options
C include a message at the bottom of the plot
C and a plot perimter.
C
C This is the super version of the CONRAN
C family of utilities. It is created by
C loading this package with DASHSUPR rather
C than DASHCHAR.
C
C Set up the scratch arrays needed by CONRAS.
C
DIMENSION WK(221),IWK(744),SCR(1600)
C
C Dimension arrays to hold the sparse dataset.
C
DIMENSION XD(17),YD(17),ZD(17)
C
C Define the dataset.
C
DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8),
1 XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15),
2 XD(16),XD(17)
3 /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20.,
4 5.,15.,10.,7.,13.,16./
C
DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8),
1 YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15),
2 YD(16),YD(17)
3 /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10.,
4 15.,15.,15.,20.,20.,8./
C
DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8),
1 ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15),
2 ZD(16),ZD(17)
3 /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1.,
4 1.,1.,1.,1.,1.,25./
C
C Define the number of points in the dataset.
C
DATA NDP/17/
C
C Set the PORT error handling routine to the recover mode.
C
CALL ENTSR(IROLD,1)
C
C Define the plot title.
C
CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAS',29,0)
C
C Test for an error condition.
C
IF (NERRO(IERROR).NE.0) GO TO 100
C
C No error encountered.
C
C
C Set the option to generate the triangulation display.
C
CALL CONOP1('TRI=ON')
C
C Again, test for an error condition.
C
IF (NERRO(IERROR).NE.0) GO TO 100
C
C No error encountered.
C
C Call CONRAS to contour the data.
C
CALL CONRAS(XD,YD,ZD,NDP,WK,IWK,SCR)
C
C Again, test for an error condition.
C
IF (NERRO(IERROR).NE.0) GO TO 100
C
C No error encountered.
C
C
C Advance the frame. CONRAS does not do so internally.
C
CALL FRAME
C
C Print the successful completion message.
C
WRITE(6,10)
10 FORMAT(' CONRAS TEST EXECUTED--SEE PLOTS TO CERTIFY')
RETURN
C
C If an error was encountered call the PORT error print routine.
C This is only necessary if you are in recover mode, else the message
C is printed automatically.
C
100 CALL EPRIN
RETURN
END
|