Please note that to compile the graphics portion of the code below,
you must link with a double precision version of NCAR Graphics, or
else you need to convert the code back to single precision before you
call the graphics routines.
PROGRAM FTEX01
C
C Example of CURV1DP, CURV2DP, CURVDDP, CURVIDP.
C
C Define dimensions, declare arrays.
C
PARAMETER (IDIM=11,IOUT=201)
DOUBLE PRECISION X
DOUBLE PRECISION Y
DOUBLE PRECISION YP
DOUBLE PRECISION TEMP
DOUBLE PRECISION XO
DOUBLE PRECISION YO
DOUBLE PRECISION YD
DOUBLE PRECISION YI
DOUBLE PRECISION SLP1
DOUBLE PRECISION SLPN
DOUBLE PRECISION SIGMA
DOUBLE PRECISION XINC
DOUBLE PRECISION CURV2DP
DOUBLE PRECISION CURVDDP
DOUBLE PRECISION CURVIDP
DIMENSION X(IDIM),Y(IDIM),YP(IDIM),TEMP(IDIM,2)
DIMENSION XO(IOUT),YO(IOUT),YD(IOUT),YI(IOUT)
C
C Specify the input data.
C
C
DATA X/0.00D0,2.00D0,5.00D0,8.00D0,10.00D0,13.00D0,15.00D0,
+ 18.00D0,21.00D0,23.00D0,30.00D0/
DATA Y/1.00D0,0.81D0,0.00D0,-0.81D0,-1.00D0,-0.84D0,-0.56D0,
+ 0.04D0,0.73D0,1.18D0,2.0D0/
C
C Call CURV1DP setup, specifying that the derivatives should be
C zero at the end points.
C
SLP1 = 0.D0
SLPN = 0.D0
ISLPSW = 0
SIGMA = 1.D0
CALL CURV1DP(IDIM,X,Y,SLP1,SLPN,ISLPSW,YP,TEMP,SIGMA,IERR)
C
C Call CURV2DP and calculate the interpolated values, the derivatives,
C and the integrals.
C
XINC = 30.D0/ (IOUT-1)
DO 10 I = 1,IOUT
XO(I) = (I-1)*XINC
YO(I) = CURV2DP(XO(I),IDIM,X,Y,YP,SIGMA)
YD(I) = CURVDDP(XO(I),IDIM,X,Y,YP,SIGMA)
YI(I) = CURVIDP(XO(1),XO(I),IDIM,X,Y,YP,SIGMA)
10 CONTINUE
C
C Draw a plot of the interpolated functions and mark the original
C points.
C
CALL DRWFT1(IDIM,X,Y,IOUT,XO,YO,YD,YI)
C
STOP
END
SUBROUTINE DRWFT1(II,X,Y,IO,XO,YO,YD,YI)
C
C Define error file, Fortran unit number, and workstation type,
C and workstation ID.
C
PARAMETER (IERRF=6,LUNIT=2,IWTYPE=1,IWKID=1)
DOUBLE PRECISION X
DOUBLE PRECISION Y
DOUBLE PRECISION XO
DOUBLE PRECISION YO
DOUBLE PRECISION YD
DOUBLE PRECISION YI
DOUBLE PRECISION YPOS_TOP
DOUBLE PRECISION YB
DOUBLE PRECISION YT
C
DATA YPOS_TOP/0.88D0/
C
C Open GKS, open and activate a workstation.
C
CALL GOPKS(IERRF,ISZDM)
CALL GOPWK(IWKID,LUNIT,IWTYPE)
CALL GACWK(IWKID)
C
C Define a color table.
C
CALL GSCR(IWKID,0,1.0D0,1.0D0,1.0D0)
CALL GSCR(IWKID,1,0.0D0,0.0D0,0.0D0)
CALL GSCR(IWKID,2,1.0D0,0.0D0,0.0D0)
CALL GSCR(IWKID,3,0.0D0,1.0D0,0.0D0)
CALL GSCR(IWKID,4,0.0D0,0.0D0,1.0D0)
CALL GSCLIP(0)
C
C Plot main title.
C
CALL PLCHHQ(0.50D0,0.95D0,':F25:Demo for CURVDP, CURVDDP, CURVIDP',
+ 0.030D0,0.D0,0.D0)
C
C Graph the interpolated function values and mark the original
C input data points.
C
YB = -1.0D0
YT = 2.0D0
CALL BKGFT1(YPOS_TOP,'Function',YB,YT)
CALL GRIDAL(6,5,3,1,1,1,10,0.0D0,YB)
C
C Mark the original data points.
C
CALL GSMKSC(2.D0)
CALL GSPMCI(4)
CALL GSLWSC(1.D0)
CALL GPM(II,X,Y)
C
C Graph the interpolated function values.
C
CALL GPL(IO,XO,YO)
C
C Graph the derivative.
C
YB = -0.3D0
YT = 0.3D0
CALL BKGFT1(YPOS_TOP-0.3D0,'Derivative',YB,YT)
CALL GRIDAL(6,5,3,1,1,1,10,0.0D0,YB)
CALL GPL(IO,XO,YD)
CALL GSPLCI(1)
C
C Graph the integral.
C
YB = -6.0D0
YT = 10.0D0
CALL BKGFT1(YPOS_TOP-0.6D0,'Integral',YB,YT)
CALL GRIDAL(6,5,4,1,1,1,10,0.0D0,YB)
CALL GPL(IO,XO,YI)
CALL GSPLCI(1)
CALL FRAME
C
CALL GDAWK(IWKID)
CALL GCLWK(IWKID)
CALL GCLKS
C
RETURN
END
SUBROUTINE BKGFT1(YPOS,LABEL,YB,YT)
DOUBLE PRECISION YPOS
DOUBLE PRECISION YB
DOUBLE PRECISION YT
DOUBLE PRECISION XX
DOUBLE PRECISION YY
DIMENSION XX(2),YY(2)
CHARACTER*(*) LABEL
C
CALL SET(0.D0,1.D0,0.D0,1.D0,0.D0,1.D0,0.D0,1.D0,1)
CALL PCSETI('FN',21)
CALL PLCHHQ(0.20D0,YPOS-0.03D0,LABEL,0.025D0,0.D0,-1.D0)
CALL SET(0.13D0,0.93D0,YPOS-0.2D0,YPOS,0.0D0,30.0D0,YB,YT,1)
XX(1) = 0.D0
XX(2) = 30.D0
YY(1) = 0.D0
YY(2) = 0.D0
CALL GSPLCI(2)
CALL GPL(2,XX,YY)
CALL GSPLCI(1)
CALL GASETI('LTY',1)
CALL PCSETI('FN',21)
CALL GASETR('XLS',0.02D0)
CALL GASETC('XLF','(I3)')
CALL GASETR('YLS',0.02D0)
CALL GASETC('YLF','(F5.1)')
CALL GASETR('XMJ',0.02D0)
CALL GASETR('YMJ',0.02D0)
C
RETURN
END
home |
contents |
defs |
params |
procedures |
exmpls