libncarg-data 6.3.0-6build1 / usr / share / ncarg / tests / tdashs.f

This file is indexed.

/usr/share/ncarg/tests/tdashs.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
      PROGRAM TDASHS
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 DASHS(IERR)
C
C DEACTIVATE AND CLOSE WORKSTATION, CLOSE GKS.
C
      CALL GDAWK (IWKID)
      CALL GCLWK (IWKID)
      CALL GCLKS
C
      STOP
      END
C
      SUBROUTINE DASHS (IERROR)
C
C PURPOSE                To provide a simple demonstration of DASHSMTH
C
C USAGE                  CALL DASHS (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               DASHSMTH TEST EXECUTED--SEE PLOT TO CERTIFY
C
C                        is printed on unit 6.  In addition, 1
C                        frame is produced on the machine graphics
C                        device.  In order to determine if the test
C                        was successful, it is necessary to examine
C                        the plot.
C
C PRECISION              Single
C
C REQUIRED ROUTINES      DASHSMTH
C
C REQUIRED GKS LEVEL     0A
C
C LANGUAGE               FORTRAN 77
C
C ALGORITHM              TDASHS utilizes the software DASHSMTH
C                        routines DASHDB, DASHDC, FRSTD, VECTD,
C                        LINED, and CURVED to draw 5 curves on 1
C                        picture using 5 different DASHSMTH patterns.
C                        Each curve is centered about solid axis
C                        lines and labelled with the binary
C                        representation of the DASHSMTH pattern used.
C
C X contains the abscissae and Y the ordinates of the curve to be plotted.
      DIMENSION       X(31)      ,Y(31)
C
C Select normalization transformation 0.
C
      CALL GSELNT(0)
C
C Set a solid dash pattern,  1111111111111111 (BINARY).
C Boolean operations (using locally-implemented support
C routines) are used to support porting to hosts with 16
C bit integers.
C
      ISOLID = IOR (ISHIFT (32767,1), 1)
C
      DO 130 K=1,5
         CALL DASHDB (ISOLID)
         ORG =1.07-0.195*K
C
C Draw the central axis for each curve.
C
         CALL FRSTD (.50,ORG-0.03)
         CALL VECTD (.50,ORG+0.03)
         CALL LASTD
         CALL LINED (.109,ORG,.891,ORG)
C
C Call DASHDC with a different dashed line and character combination
C for each of 5 different curves.
C
         GO TO ( 10, 20, 30, 40, 50),K
   10    CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12)
         GO TO  60
   20    CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12)
         GO TO  60
   30    CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12)
         GO TO  60
   40    CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12)
         GO TO  60
   50    CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12)
   60    CONTINUE
C
C Compute the curve coordinates and draw the curve.
C
         DO  70 I=1,31
            THETA = REAL(I-1)*3.1415926535897932/15.
            X(I) = 0.5+.4*COS(THETA)
            Y(I) = ORG+.075*SIN(REAL(K)*THETA)
   70    CONTINUE
         CALL CURVED (X,Y,31)
C
C Label the curves with the character representation of the appropriate
C DASHSMTH pattern.  In the pattern labels, A and D should be interpreted
C as the apostrophe and dollar sign.
C
C Locate the string at the left end, but vertically centered.
C
        CALL GSTXAL(1,3)
C
C Set the character height.
C
         CALL GSCHH(.012)
C
         ORY = ORG+.089
         GO TO ( 80, 90,100,110,120),K
   80    CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1')
         GO TO 130
   90    CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2')
         GO TO 130
  100    CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3')
         GO TO 130
  110    CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4')
         GO TO 130
  120    CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5')
C
  130 CONTINUE
C
      CALL GSTXAL(2,3)
      CALL GTX (.5,.985,'DEMONSTRATION PLOT FOR DASHSMTH')
      CALL GTX (.5,.013,'IN IPAT STRINGS, A AND D SHOULD BE INTERPRETED
     1AS APOSTROPHE AND DOLLAR SIGN')
      CALL FRAME
C
      IERROR = 0
      WRITE (6,1001)
C
      RETURN
C
 1001 FORMAT (' DASHSMTH TEST EXECUTED--SEE PLOT TO CERTIFY')
C
      END

APT Browse - Built by Thomas Orozco.