The following code uses NCAR Graphics to produce surface plots,
vector plots, and contour plots for the Natgrid examples.
SUBROUTINE DRWCON(NX,NY,XI,YI,ZDAT)
C
C Use the NCAR Graphics CONPACK package to draw a color contour
C plot of the data in ZDAT.
C
PARAMETER (IERRF=6, LUNIT=2, IWKID=1, IWTYPE=1)
C
DIMENSION ZDAT(NX,NY)
DIMENSION RWRK(2000),IWRK(1000),IAMA(20000)
DIMENSION XCRA(1000),YCRA(1000),IAIA(10),IGIA(10)
C
EXTERNAL CPCOLR,CPDRPL
C
C Open GKS if not open; open and activate a workstation; define
C some colors.
C
JTYPE = IWTYPE
CALL GQOPS(ISTATE)
IF (ISTATE .EQ. 0) THEN
CALL GOPKS (IERRF, ISZDM)
IF (JTYPE .EQ. 1) THEN
CALL NGSETC('ME','con.ncgm')
ELSE IF ( (JTYPE .GE. 20) .AND. (JTYPE .LE. 31) ) THEN
CALL NGSETC('ME','con.ps')
ENDIF
CALL GOPWK (IWKID, LUNIT, JTYPE)
CALL GACWK (IWKID)
CALL GSCR(IWKID, 0, 1.00, 1.00, 1.00)
CALL GSCR(IWKID, 1, 0.00, 0.00, 0.00)
CALL GSCR(IWKID, 2, 0.00, 1.00, 1.00)
CALL GSCR(IWKID, 3, 0.00, 1.00, 0.00)
CALL GSCR(IWKID, 4, 0.70, 1.00, 0.00)
CALL GSCR(IWKID, 5, 1.00, 1.00, 0.00)
CALL GSCR(IWKID, 6, 1.00, 0.75, 0.00)
CALL GSCR(IWKID, 7, 1.00, 0.50, 0.50)
CALL GSCR(IWKID, 8, 1.00, 0.00, 0.00)
ENDIF
C
IERR = 0
C
CALL CPSETI('CLS - CONTOUR LEVEL SELECTOR',0)
CALL CPSETI('NCL - NUMBER OF CONTOUR LEVELS',7)
C
DO 103 I=1,7
CALL CPSETI('PAI - parameter array index',I)
CALL CPSETR('CLV - contour level',10.*REAL(I))
CALL CPSETI('CLU - contour level use',3)
CALL CPSETI('LLC - contour label color',1)
103 CONTINUE
C
C Initialize the drawing of the contour plot.
C
CALL CPSETR('VPL - viewport left',0.05)
CALL CPSETR('VPR - viewport right',0.95)
CALL CPSETR('VPB - viewport bottom',0.05)
CALL CPSETR('VPT - viewport top',0.95)
CALL PCSETI('FN - font number (Helvetica bold)' ,22)
CALL PCSETI('CC - font color',1)
CALL CPSETR('T2D - tension of 2D splines',4.)
CALL CPSETI('LLP - line label positioning, penalty scheme',3)
CALL CPSETI('LLO - line label orientation',1)
CALL CPSETC('LOT - low labels off',' ')
CALL CPSETR('CWM - character width multiplier',2.5)
CALL CPSETC('ILT - informational label off',' ')
CALL CPRECT(ZDAT,NX,NX,NY,RWRK,2000,IWRK,1000)
C
C Initialize the area map and put the contour lines into it.
C
CALL ARINAM (IAMA,20000)
CALL CPCLAM (ZDAT,RWRK,IWRK,IAMA)
CALL CPLBAM (ZDAT,RWRK,IWRK,IAMA)
C
C Color the map.
C
CALL ARSCAM (IAMA,XCRA,YCRA,1000,IAIA,IGIA,7,CPCOLR)
C
C Put black contour lines over the colored map.
C
CALL GSPLCI (1)
CALL CPCLDM (ZDAT,RWRK,IWRK,IAMA,CPDRPL)
CALL CPLBDR (ZDAT,RWRK,IWRK)
CALL PERIM(1,0,1,0)
C
CALL FRAME
C
C Close down GKS.
C
IF (ISTATE .EQ. 0) THEN
CALL GDAWK (IWKID)
CALL GCLWK (IWKID)
CALL GCLKS
ENDIF
C
RETURN
END
SUBROUTINE CPCOLR (XCRA,YCRA,NCRA,IAIA,IGIA,NAIA)
C
DIMENSION XCRA(*),YCRA(*),IAIA(*),IGIA(*)
C
DO 102 I=1,NAIA
IF (IGIA(I) .EQ. 3) IFLL = IAIA(I)
102 CONTINUE
IF (IFLL.GE.1 .AND. IFLL.LE.8) THEN
CALL GSFACI (IFLL+1)
CALL GFA (NCRA-1,XCRA,YCRA)
END IF
C
RETURN
END
SUBROUTINE DRWSRF(NX,NY,X,Y,Z,S1,S2,S3,IWK)
C
C Procedure DRWSRF uses the NCAR Graphics function SRFACE to
C draw a surface plot of the data values in Z.
C
C The point of observation is calculated from the 3D coordinate
C (S1, S2, S3); the point looked at is the center of the surface.
C
C NX - Dimension of the X-axis variable X.
C NY - Dimension of the Y-axis variable Y.
C X - An array of X-axis values.
C Y - An array of Y-axis values.
C Z - An array dimensioned for NX x NY containing data
C values for each (X,Y) coordinate.
C S1 - X value for the eye position.
C S2 - Y value for the eye position.
C S3 - Z value for the eye position.
C IWK - Work space dimensioned for at least 2*NX*NY.
C
C
DIMENSION X(NX),Y(NY),Z(NX,NY),IWK(*)
C
PARAMETER (IERRF=6, LUNIT=2, IWKID=1, IWTYPE=8)
DIMENSION S(6)
C
C Open GKS, open and activate a workstation.
C
JTYPE = IWTYPE
CALL GQOPS(ISTATE)
IF (ISTATE .EQ. 0) THEN
CALL GOPKS (IERRF, ISZDM)
IF (JTYPE .EQ. 1) THEN
CALL NGSETC('ME','srf.ncgm')
ELSE IF ( (JTYPE .GE. 20) .AND. (JTYPE .LE. 31) ) THEN
CALL NGSETC('ME','srf.ps')
ENDIF
CALL GOPWK (IWKID, LUNIT, JTYPE)
CALL GSCR(IWKID,0,1.,1.,1.)
CALL GSCR(IWKID,1,0.,0.,0.)
CALL GACWK (IWKID)
ENDIF
C
C Find the extreme values.
C
XMX = X(1)
YMN = Y(1)
YMX = Y(1)
ZMN = Z(1,1)
ZMX = Z(1,1)
C
DO 10 I=2,NX
XMN = MIN(XMN,X(I))
XMX = MAX(XMX,X(I))
10 CONTINUE
C
DO 11 I=1,NY
YMN = MIN(YMN,Y(I))
YMX = MAX(YMX,Y(I))
11 CONTINUE
C
DO 12 I=1,NX
DO 13 J=1,NY
ZMN = MIN(ZMN,Z(I,J))
ZMX = MAX(ZMX,Z(I,J))
13 CONTINUE
12 CONTINUE
C
IF (S1.EQ.0. .AND. S2.EQ.0. .AND. S3.EQ.0.) THEN
ST1 = -3.
ST2 = -1.5
ST3 = 0.75
ELSE
ST1 = S1
ST2 = S2
ST3 = S3
ENDIF
S(1) = 5.*ST1*(XMX-XMN)
S(2) = 5.*ST2*(YMX-YMN)
S(3) = 5.*ST3*(ZMX-ZMN)
S(4) = 0.5*(XMX-XMN)
S(5) = 0.5*(YMX-YMN)
S(6) = 0.5*(ZMX-ZMN)
C
CALL SRFACE (X,Y,Z,IWK,NX,NX,NY,S,0.)
C
C Close down GKS.
C
IF (ISTATE .EQ. 0) THEN
CALL GDAWK (IWKID)
CALL GCLWK (IWKID)
CALL GCLKS
ENDIF
C
RETURN
END
SUBROUTINE DRWVCT(LX,LY,U,V)
C
C Where U and V are 2D arrays, this subroutine uses NCAR Graphics to
C draw a vector plot of the vectors (U(I,J),V(I,J))
C for I=1,LX and J=1,LY.
C
DIMENSION U(LX,LY),V(LX,LY)
PARAMETER (IERRF=6, LUNIT=2, IWKID=1, IWTYPE=8)
C
JTYPE = IWTYPE
CALL GQOPS(ISTATE)
IF (ISTATE .EQ. 0) THEN
CALL GOPKS (IERRF, ISZDM)
IF (JTYPE .EQ. 1) THEN
CALL NGSETC('ME','vec.ncgm')
ELSE IF ( (JTYPE .GE. 20) .AND. (JTYPE .LE. 31) ) THEN
CALL NGSETC('ME','vec.ps')
ENDIF
CALL GOPWK (IWKID, LUNIT, JTYPE)
CALL GACWK (IWKID)
CALL GSCR(IWKID, 0, 1.00, 1.00, 1.00)
CALL GSCR(IWKID, 1, 0.00, 0.00, 0.00)
ENDIF
C
CALL VVINIT(U,LX,V,LY,PDUM,1,LX,LY,WRK,1)
CALL VVSETC('MNT',' ')
CALL VVSETC('MXT',' ')
CALL VVECTR(U,V,P,IAM,VVMSKD,WRK)
CALL FRAME
C
IF (ISTATE .EQ. 0) THEN
CALL GDAWK (IWKID)
CALL GCLWK (IWKID)
CALL GCLKS
ENDIF
C
RETURN
END
home |
contents |
defs |
params |
procedures |
exmpls |
index