xgfinterface.f.in

xgrafix 是PTSG模拟程序中的图形截面库 改版本是最新版本

*     FORTRAN Interface Code for Xgrafix
*****************************************************************
*     Subroutine XGINIT initializes the XGrafix package.
****************************************************************
      SUBROUTINE xginit(thetime)
*     Global Symbols:
        COMMON /labels/ labindex, plottype(100),
     +                  state(100), title(100),
     +                  xlabel(100), ylabel(100)
        INTEGER labindex
        CHARACTER*(80) plottype, state, title, xlabel, ylabel

*     Input Arguments:
        DOUBLE PRECISION thetime
        CHARACTER*(80) arg

*     Externals:
        EXTERNAL strlennb, iargc, getarg
        INTEGER strlennb, iargc

*     Local Symbols:
        INTEGER lenname, indx, k
        CHARACTER*(80) name1p, name2p, name3p, name4p, name5p,
     +                 name6p, name7p, name8p, name9p, name10p,
     +                 name11p,name12p,name13p,name14p,name15p,
     +                 name16p,names(16)
*     Initialize the label index counter.
      labindex = 0
      indx = iargc()

*     Convert the input FORTRAN strings to C strings.
      DO 10 k=0,indx
         CALL getarg (k, arg)
         lenname = STRLENNB(arg)
         names(k+1) =  arg(1:lenname) // char(0)
 10   CONTINUE

      DO 20 k = indx+1, 16
	names(k+1) = ' ' // char(0)
 20   CONTINUE

      name1p = names(1)
      name2p = names(2)
      name3p = names(3)
      name4p = names(4)
      name5p = names(5)
      name6p = names(6)
      name7p = names(7)
      name8p = names(8)
      name9p = names(9)
      name10p = names(10)
      name11p = names(11)
      name12p = names(12)
      name13p = names(13)
      name14p = names(14)
      name15p = names(15)
      name16p = names(16)

      CALL initxg(indx + 1,name1p,name2p,name3p,name4p,name5p,
     +  name6p,name7p,name8p,name9p,name10p,name11p,name12p,
     +  name13p,name14p,name15p,name16p,thetime)

      RETURN
      END
*
****************************************************************
*     Subroutine XGSTART refreshes the screen and
*     checks for events.
****************************************************************
      SUBROUTINE xgstart

      CALL startxg

      RETURN
      END


****************************************************************
*     Subroutine XGSETVEC sets up the information for the
*     initialization of a 2-D vector plot under XGrafix.
****************************************************************
      SUBROUTINE xgsetvec(pt,xl,yl,tl,ws,wulx,wuly,xscale,yscale,
     +                   xauto,yauto,xmin,xmax,ymin,ymax)
*     Global Symbols:
      COMMON /labels/ labindex, plottype(100),
     +     state(100), title(100),
     +     xlabel(100), ylabel(100)
      INTEGER labindex
      CHARACTER*(80) plottype, state, title, xlabel, ylabel
      
*     Input Arguments:
      INTEGER wulx, wuly, xauto, yauto
      SCALAR xmax, xmin, xscale, ymax, ymin, yscale
      CHARACTER*(*) pt, tl, ws, xl, yl
      
*     Convert the input FORTRAN strings to C strings.
      labindex           = labindex + 1
      IF (labindex .GT. 100) THEN
         WRITE(6,1000)
 1000    FORMAT("Number of initialized windows exceeds ",
     +        "established allocation!")
         STOP
      ENDIF
      plottype(labindex) = pt // char(0)
      state(labindex)    = ws // char(0)
      title(labindex)    = tl // char(0)
      xlabel(labindex)   = xl // char(0)
      ylabel(labindex)   = yl // char(0)
      
      CALL setvecxg(plottype(labindex),xlabel(labindex),
     +     ylabel(labindex),title(labindex),state(labindex),
     +     wulx,wuly,xscale,yscale,xauto,yauto,
     +     xmin,xmax,ymin,ymax)
      
      RETURN
      END
*     
****************************************************************
*     Subroutine XGSETVECFLAG does the same thing as XGSETVEC
*     but also provides a flag that Xgrafix sets on or off
*     depending on whether the plot window is open or closed.
****************************************************************
      SUBROUTINE xgsetvecflag(pt,xl,yl,tl,ws,wulx,wuly,xscale,yscale,
     +                   xauto,yauto,xmin,xmax,ymin,ymax,openflag)
*     Global Symbols:
      COMMON /labels/ labindex, plottype(100),
     +     state(100), title(100),
     +     xlabel(100), ylabel(100)
      INTEGER labindex
      CHARACTER*(80) plottype, state, title, xlabel, ylabel
      
*     Input Arguments:
      INTEGER wulx, wuly, xauto, yauto, openflag
      SCALAR xmax, xmin, xscale, ymax, ymin, yscale
      CHARACTER*(*) pt, tl, ws, xl, yl
      
*     Convert the input FORTRAN strings to C strings.
      labindex           = labindex + 1
      IF (labindex .GT. 100) THEN
         WRITE(6,1000)
 1000    FORMAT("Number of initialized windows exceeds ",
     +        "established allocation!")
         STOP
      ENDIF
      plottype(labindex) = pt // char(0)
      state(labindex)    = ws // char(0)
      title(labindex)    = tl // char(0)
      xlabel(labindex)   = xl // char(0)
      ylabel(labindex)   = yl // char(0)
      
      CALL setvecxgflag(plottype(labindex),xlabel(labindex),
     +     ylabel(labindex),title(labindex),state(labindex),
     +     wulx,wuly,xscale,yscale,xauto,yauto,
     +     xmin,xmax,ymin,ymax,openflag)
      
      RETURN
      END
*     
****************************************************************
*     Subroutine XGSET2D sets up the information for the
*     initialization of a 2-D (X-Y) line or scatter plot
*     under XGrafix.
****************************************************************
      SUBROUTINE xgset2d(pt,xl,tl,ws,wulx,wuly,xscale,yscale,
     +                   xauto,yauto,xmin,xmax,ymin,ymax)
*     Global Symbols:
      COMMON /labels/ labindex, plottype(100),
     +     state(100), title(100),
     +     xlabel(100), ylabel(100)
      INTEGER labindex
      CHARACTER*(80) plottype, state, title, xlabel, ylabel
      
*     Input Arguments:
      INTEGER wulx, wuly, xauto, yauto
      SCALAR xmax, xmin, xscale, ymax, ymin, yscale
      CHARACTER*(*) pt, tl, ws, xl
      
*     Convert the input FORTRAN strings to C strings.
      labindex           = labindex + 1
      IF (labindex .GT. 100) THEN
         WRITE(6,1000)
 1000    FORMAT("Number of initialized windows exceeds ",
     +        "established allocation!")
         STOP
      ENDIF
      plottype(labindex) = pt // char(0)
      state(labindex)    = ws // char(0)
      title(labindex)    = tl // char(0)
      xlabel(labindex)   = xl // char(0)
      
      CALL set2dxg(plottype(labindex),xlabel(labindex),
     +     title(labindex),state(labindex),
     +     wulx,wuly,xscale,yscale,xauto,yauto,
     +     xmin,xmax,ymin,ymax)
      
      RETURN
      END
*     
****************************************************************
*     Subroutine XGSET2DFLAG does the same as XGSET2D but
*     also provides a flag that XGrafix turns on or off 
*     depending on whether the plot window is open or closed.
****************************************************************
      SUBROUTINE xgset2dflag(pt,xl,tl,ws,wulx,wuly,xscale,yscale,
     +                   xauto,yauto,xmin,xmax,ymin,ymax,openflag)
*     Global Symbols:
      COMMON /labels/ labindex, plottype(100),
     +     state(100), title(100),
     +     xlabel(100), ylabel(100)
      INTEGER labindex
      CHARACTER*(80) plottype, state, title, xlabel, ylabel
      
*     Input Arguments:
      INTEGER wulx, wuly, xauto, yauto,openflag
      SCALAR xmax, xmin, xscale, ymax, ymin, yscale
      CHARACTER*(*) pt, tl, ws, xl
      
*     Convert the input FORTRAN strings to C strings.
      labindex           = labindex + 1
      IF (labindex .GT. 100) THEN
         WRITE(6,1000)
 1000    FORMAT("Number of initialized windows exceeds ",
     +        "established allocation!")
         STOP
      ENDIF
      plottype(labindex) = pt // char(0)
      state(labindex)    = ws // char(0)
      title(labindex)    = tl // char(0)
      xlabel(labindex)   = xl // char(0)
      
      CALL set2dxgflag(plottype(labindex),xlabel(labindex),
     +     title(labindex),state(labindex),
     +     wulx,wuly,xscale,yscale,xauto,yauto,
     +     xmin,xmax,ymin,ymax,openflag)
      
      RETURN
      END
*     
****************************************************************
*     Subroutine XGSET2DC sets up the information for the
*     initialization of a 2-D contour plot under XGrafix.
****************************************************************
      SUBROUTINE xgset2dc(pt,xl,yl,tl,ws,wulx,wuly,xscale,
     +     yscale,zscale,xauto,yauto,zauto,
     +     xmin,xmax,ymin,ymax,zmin,zmax)
*     Global Symbols:
      COMMON /labels/ labindex, plottype(100),
     +     state(100), title(100),
     +     xlabel(100), ylabel(100)
      INTEGER labindex
      CHARACTER*(80) plottype, state, title, xlabel, ylabel
      
*     Input Arguments:
      INTEGER wulx, wuly, xauto, yauto, zauto
      SCALAR xmax, xmin, xscale, ymax, ymin, yscale
      SCALAR zmax, zmin, zscale
      CHARACTER*(*) pt, tl, ws, xl, yl
      
*     Convert the input FORTRAN strings to C strings.
      labindex           = labindex + 1
      IF (labindex .GT. 100) THEN
         WRITE(6,1000)
 1000    FORMAT("Number of initialized windows exceeds ",
     +        "established allocation!")
         STOP
      ENDIF
      plottype(labindex) = pt // char(0)
      state(labindex)    = ws // char(0)
      title(labindex)    = tl // char(0)
      xlabel(labindex)   = xl // char(0)
      ylabel(labindex)   = yl // char(0)
      
      CALL set2dcxg(plottype(labindex),xlabel(labindex),
     +     ylabel(labindex),title(labindex),
     +     state(labindex),wulx,wuly,xscale,
     +     yscale,zscale,xauto,yauto,zauto,
     +     xmin,xmax,ymin,ymax,zmin,zmax)
      
      RETURN
      END
*     
*     
****************************************************************
*     Subroutine XGSET2DCFLAG does the same as XGSET2DC but
*     also has a flag which XGrafix turns on or off depending
*     on whether the plot window is open or closed.
****************************************************************
      SUBROUTINE xgset2dcflag(pt,xl,yl,tl,ws,wulx,wuly,xscale,
     +     yscale,zscale,xauto,yauto,zauto,
     +     xmin,xmax,ymin,ymax,zmin,zmax,openflag)
*     Global Symbols:
      COMMON /labels/ labindex, plottype(100),
     +     state(100), title(100),
     +     xlabel(100), ylabel(100)
      INTEGER labindex
      CHARACTER*(80) plottype, state, title, xlabel, ylabel
      
*     Input Arguments:
      INTEGER wulx, wuly, xauto, yauto, zauto,openflag
      SCALAR xmax, xmin, xscale, ymax, ymin, yscale
      SCALAR zmax, zmin, zscale
      CHARACTER*(*) pt, tl, ws, xl, yl
      
*     Convert the input FORTRAN strings to C strings.
      labindex           = labindex + 1
      IF (labindex .GT. 100) THEN
         WRITE(6,1000)
 1000    FORMAT("Number of initialized windows exceeds ",
     +        "established allocation!")
         STOP
      ENDIF
      plottype(labindex) = pt // char(0)
      state(labindex)    = ws // char(0)
      title(labindex)    = tl // char(0)
      xlabel(labindex)   = xl // char(0)
      ylabel(labindex)   = yl // char(0)
      
      CALL set2dcxgflag(plottype(labindex),xlabel(labindex),
     +     ylabel(labindex),title(labindex),
     +     state(labindex),wulx,wuly,xscale,
     +     yscale,zscale,xauto,yauto,zauto,
     +     xmin,xmax,ymin,ymax,zmin,zmax,openflag)
      
      RETURN
      END

*     
****************************************************************
*     Subroutine XGSET3D sets up the information for the