     	SUBROUTINE FUNPLT_MAIN
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY-1987
C
C	THIS ROUTINE CALCULATES A USER SPECIFIED FUNCTION
C	IN RELATIONSHIP OF Z=F(X,Y) AND WRITE OUT A DIGITIZED
C	DATA FILE FOR X,Y PLOT OR CONTOUR PLOT.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL

     	PARAMETER NKS= 17
     	CHARACTER KEY*2, KWD(NKS)*2, TEXT*80
     	EQUIVALENCE (KEY, TEXT(1:2))
C
C  ACCESS 2 LETTER CODES TO FUNCTION PARAMETERS...
C
     	DATA KWD / 'FZ', 'FF', 'DF', 'NX', 'XR', 'NY', 'YR',
     + 'C0', 'C1', 'C2', 'C3', 'C4', 'C5', 'C6', 'C7', 'C8', 'C9' /
C
C  INITIALIZE...
C
     	CALL FUNPLT_INIT
C
C  GET A FUNCTION TO CALCULATE IF AT ALL...
C
     	NCHS = FUNPLT_IO(1)
C
C  LAYOUT THE DIALOGUE MENU...
C
     	CALL FUNPLT_MENU
C
C  START THE DIALOGUE CYCLE...
C
111	CALL IFANSI_VIDEO(47)
     	CALL IFANSI_TEXT('FUNPLT> ', 8, 20, 1 )
     	CALL IFANSI_CLEAR(4)
     	IK = IFQIOW( NCHS, TEXT )
     	IF( IK.EQ.26) GOTO 999
     	IF( NCHS.EQ.0 ) GOTO 333
     	NCHS = IFMISC_STRIP(TEXT)
     	CALL   IFMISC_UPPER(KEY)
     	IF( KEY.EQ.'EX' .OR. KEY.EQ.'QU' ) GOTO 999
     	CALL FUNPLT_CLEAR_OOPS
     	CALL IFANSI_CURSOR(21,1)
     	CALL IFANSI_CLEAR(2)
C
C  COMMAND INPUT...
C
     	IF( TEXT(3:3).NE.'=' ) THEN
     	    CALL FUNPLT_COM( IK, TEXT )
     	    GOTO 111
     	ENDIF
C
C  PARAMETER INPUT...
C
     	DO IK=1, NKS
     	   IF( KEY.EQ.KWD(IK) ) GOTO 222
     	ENDDO
     	CALL FUNPLT_ERROR(1)
     	GOTO 111
C
C  BRANCHS TO THE DESIRED GROUP...
C
222	TEXT = TEXT(4:)
     	NCHS = NCHS-3
     	IF( IK.EQ.1 ) THEN
     	    CALL FUNPLT_FUNCTION( NCHS, TEXT )
     	ELSE IF( IK.LT.9 ) THEN
     	    CALL FUNPLT_OVERALL( IK-1, NCHS, TEXT )
     	ELSE
     	    CALL FUNPLT_CONSTANT( IK-8, NCHS, TEXT )
     	ENDIF
     	GOTO 111
C
C  EXECUTE THE USER FUNCTION...
C
333	IF( NFUN.GT.0 ) THEN
     	    IF( XCAL .AND. XBEG.EQ.XEND ) THEN
     		CALL FUNPLT_ERROR(6)
     		GOTO 111
     	    ENDIF
     	    IF( YCAL .AND. YBEG.EQ.YEND ) THEN
     		CALL FUNPLT_ERROR(7)
     		GOTO 111
     	    ENDIF
     	    CALL FUNPLT_OOPS(' Computation in progress...')
     	    CALL IFANSI_CURSOR(20,1)
     	    CALL IFANSI_VIDEO(47)
     	    CALL FUNPLT_CALC
     	    GOTO 111
     	ENDIF

999	RETURN
     	END

     	SUBROUTINE FUNPLT_FUNCTION( NK, INPUT )
C
C	THIS ROUTINE GETS USER MATH FUNCTION.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL
     	CHARACTER TEXT*80, INPUT*(*)

     	NCHS = NK
     	TEXT = INPUT
     	IF( NFUN.GT.0 ) THEN
     	    DO  I=1, NFUN
     		FUNC(I:I) = ' '
     	    ENDDO
     	    IDUM = NFUN/77
     	    IF( IDUM*77.LT.NFUN ) IDUM = IDUM + 1
     	    DO  I=3, IDUM+2
     		CALL IFANSI_CURSOR(I,4)
     		CALL IFANSI_CLEAR(4)
     	    ENDDO
     	    NFUN = 0
     	ENDIF
     	CALL IFANSI_TEXT(' Enter RETURN to end f(x,y) input ',34,7,24)
     	IF( NCHS.GT.0 ) CALL IFANSI_TEXT( TEXT, NCHS, 3, 4 )
     	IDUM = 3
     	NOLD = 0
C
C  GET THE INPUT LINE...
C
111	NCHS = IFMISC_STRIP(TEXT)
     	CALL   IFMISC_UPPER(TEXT)
     	DO I=1, NCHS
     	    IF( TEXT(I:I).NE.' ' ) THEN
     	        NFUN = NFUN + 1
     	        FUNC(NFUN:NFUN) = TEXT(I:I)
     	    ENDIF
     	ENDDO
     	IF( IDUM.EQ.7 ) GOTO 222
     	IF( NFUN.GT.NOLD ) IDUM = IDUM + 1
     	CALL IFANSI_CURSOR( IDUM, 4 )
     	READ(5,100,ERR=222,END=222) TEXT
100	FORMAT(A)
     	IF( TEXT.EQ.' ' ) GOTO 222
     	NOLD = NFUN
     	GOTO 111
C
C  DISPLAY THE FUNCTION...
C
222	IF( IDUM.LT.7 ) THEN
     	    CALL IFANSI_CURSOR(7,4)
     	    CALL IFANSI_CLEAR(4)
     	ENDIF
     	IF( NFUN.GT.0 ) THEN
     	    DO  I=3, IDUM
     		CALL IFANSI_CURSOR(I,4)
     		CALL IFANSI_CLEAR(4)
     	    ENDDO
     	    CALL FUNPLT_FXY
     	    IF( NFUN.GT.0 ) THEN
     		CALL FUNPLT_DATA(1)
     	    ELSE
     		CALL FUNPLT_ERROR(9)
     	    ENDIF
     	ENDIF

     	RETURN
     	END

     	SUBROUTINE FUNPLT_FXY
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL

     	DO  I=1, NFUN
     	    IF( FUNC(I:I).EQ.'X' ) GOTO 333
     	ENDDO
     	XCAL = .FALSE.
     	GOTO 444
333	XCAL = .TRUE.
444	DO  I=1, NFUN
     	    IF( FUNC(I:I).EQ.'Y' ) GOTO 555
     	ENDDO
     	YCAL = .FALSE.
     	GOTO 666
555	YCAL = .TRUE.
666     IF( XCAL .OR. YCAL ) THEN
     	    FUNC(NFUN+1:) = ' '
     	ELSE
     	    NFUN = 0
     	    FUNC = ' '
     	ENDIF
     	RETURN
     	END

     	SUBROUTINE FUNPLT_OVERALL( IK, NK, INPUT )
C
C	THIS ROUTINE GETS OVREALL PARAMETERS.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL
     	CHARACTER TEXT*80, INPUT*(*)
     	DIMENSION KP(2), RP(2)

     	IKEY = IK
     	NCHS = NK
     	TEXT = INPUT
     	IF( IKEY.EQ.1 ) THEN	!FUNCTION FILE INPUT
     	    FNAME = TEXT
     	    IF( NCHS.GT.0 ) THEN
     		CALL IFMISC_DEFEXT( FNAME, '.FUN' )
     		NCHS = FUNPLT_IO(1)
     		IF( NCHS.EQ.1 ) THEN
     		    CALL FUNPLT_DATA(0)
     		ELSE
     		    CALL FUNPLT_DATA(12)
     		    CALL FUNPLT_ERROR(8)
     		ENDIF
     	    ENDIF
     	    GOTO 999
     	ENDIF

     	IF( IKEY.EQ.2 ) THEN	!OUTPUT DATA INPUT
     	    IF( NCHS.EQ.0 ) GOTO 777
     	    DNAME = TEXT
     	    CALL FUNPLT_DATA(13)
     	    GOTO 999
     	ENDIF

     	IF( IKEY.EQ.3 ) THEN
     	    IF( NCHS.EQ.0 ) GOTO 777
     	    NCHS = IFMISC_DECODE( TEXT, 1, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 888
     	    IF( RP(1).LT.2.0 .OR. RP(1).GT.9999 ) GOTO 666
     	    NPTX = RP(1)
     	    CALL FUNPLT_DATA(14)
     	    GOTO 999
     	ENDIF

     	IF( IKEY.EQ.4 ) THEN
     	    IF( NCHS.EQ.0 ) GOTO 777
     	    NCHS = IFMISC_DECODE( TEXT, 2, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 888
     	    IF( KP(1).EQ.0 ) RP(1) = XBEG
     	    IF( KP(2).EQ.0 ) RP(2) = XEND
     	    IF( RP(1).EQ.RP(2) ) GOTO 888
     	    XBEG = RP(1)
     	    XEND = RP(2)
     	    CALL FUNPLT_DATA(15)
     	    GOTO 999
     	ENDIF

     	IF( IKEY.EQ.5 ) THEN
     	    IF( NCHS.EQ.0 ) GOTO 777
     	    NCHS = IFMISC_DECODE( TEXT, 1, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 888
     	    IF( RP(1).LT.2.0 .OR. RP(1).GT.9999 ) GOTO 666
     	    NPTY = RP(1)
     	    CALL FUNPLT_DATA(16)
     	    GOTO 999
     	ENDIF

     	IF( IKEY.EQ.6 ) THEN
     	    IF( NCHS.EQ.0 ) GOTO 777
     	    NCHS = IFMISC_DECODE( TEXT, 2, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 888
     	    IF( KP(1).EQ.0 ) RP(1) = YBEG
     	    IF( KP(2).EQ.0 ) RP(2) = YEND
     	    IF( RP(1).EQ.RP(2) ) GOTO 888
     	    YBEG = RP(1)
     	    YEND = RP(2)
     	    CALL FUNPLT_DATA(17)
     	    GOTO 999
     	ENDIF

666	CALL FUNPLT_ERROR(4)
     	GOTO 999
777	CALL FUNPLT_ERROR(5)
     	GOTO 999
888	CALL FUNPLT_ERROR(3)
999	RETURN
     	END

     	SUBROUTINE FUNPLT_CONSTANT( IK, NK, INPUT )
C
C	THIS ROUTINE GETS FORMULAR CONSTANTS.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL
     	CHARACTER TEXT*80, INPUT*(*)

     	NCHS = NK
     	IF( NCHS.EQ.0 ) THEN
     	    CALL FUNPLT_ERROR(5)
     	    GOTO 999
     	ENDIF
     	IKEY = IK
     	TEXT = INPUT
     	NCHS = IFMISC_DECODE( TEXT, 1, CONS, JUNK )
     	IF( NCHS.EQ.0 ) THEN
     	    CALL FUNPLT_ERROR(3)
     	    GOTO 999
     	ENDIF
     	CS(IKEY) = JUNK
     	CALL FUNPLT_DATA(IKEY+1)

999	RETURN
     	END

     	SUBROUTINE FUNPLT_INIT
C
C	THIS ROUTINE INITIALIZE FUNCTION PLOT.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL

     	CRT  = IFINIT_ITM(0)
     	NFUN = 0
     	FUNC = ' '
     	XCAL = .FALSE.
     	YCAL = .FALSE.
     	NPTX = 100
     	XBEG = 0.0
     	XEND = 0.0
     	NPTY = 100
     	YBEG = 0.0
     	YEND = 0.0
     	DO I=1, 10
     	   CS(I) = 0.0
     	ENDDO
     	FNAME = 'JUNK.FUN'
     	DNAME = 'JUNK.DAT'

     	RETURN
     	END

     	SUBROUTINE FUNPLT_MENU
C
C	THIS ROUTINE LAYOUTS DIALOGUE MENU FOR FUNPLT.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL

     	CALL IFINIT_LINE(24)
     	CALL IFANSI_MARGIN(21,0)
     	CALL IFANSI_TITLE('GRAFIT: Math Function z=f(x,y) Plotting')
     	IF( CRT.EQ.2 ) THEN
     	    CALL IFANSI_VIDEO(50)
     	ELSE
     	    CALL IFANSI_VIDEO(47)
     	    CALL IFANSI_VIDEO(90)
     	ENDIF
     	WRITE(6,1000)
1000	FORMAT('   * * * *   M A T H   F U N C T I O N',
     +'   Z = F ( X , Y )   I N P U T   * * * *   ')
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,1001)
1001	FORMAT(' FZ=',3(/x,3('.')))
     	IF( CRT.NE.2 ) CALL IFANSI_VIDEO(90)
     	WRITE(6,1002)
1002	FORMAT(X,'...',76X,' ')

     	IF( CRT.EQ.2 ) THEN
     	    CALL IFANSI_VIDEO(50)
     	ELSE
     	    CALL IFANSI_VIDEO(47)
     	    CALL IFANSI_VIDEO(90)
     	ENDIF
     	WRITE(6,2000)
2000	FORMAT('     * * * * * *   F O R M U L A R   C O N S T A N T',
     +'   I N P U T   * * * * * *   ')
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,2001)
2001	FORMAT(
     +' C0=',13X,'C1=',13X,'C2=',13X,'C3=',13X,'C4=')
     	IF( CRT.NE.2 ) CALL IFANSI_VIDEO(90)
     	WRITE(6,2002)
2002	FORMAT(' C5=',13X,'C6=',13X,'C7=',13X,'C8=',13X,'C9=',12X,' ')
     	IF( CRT.EQ.2 ) THEN
     	    CALL IFANSI_VIDEO(50)
     	ELSE
     	    CALL IFANSI_VIDEO(47)
     	    CALL IFANSI_VIDEO(90)
     	ENDIF
     	WRITE(6,3000)
3000	FORMAT('     * * * *   P L O T   A N D   F I L E',
     +'   M A N I P U L A T I O N   * * * *     ')
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,3001)
3001	FORMAT(
     +' FF=',33X,'==> File to get or to store f(x,y)'/
     +' DF=',33X,'==> Output data filename for plotting f(x,y)'/
     +' NX=',33X,'==> Number of x-points to calculate f(x,y)'/
     +' XR=',33X,'==> X-coordinate range to calculate f(x,y)'/
     +' NY=',33X,'==> Number of y-points to calculate f(x,y)'/
     +' YR=',33X,'==> Y-coordinate range to calculate f(x,y)')
     	CALL IFANSI_VIDEO(90)
     	WRITE(6,3002)
3002	FORMAT(X,80(' '))
     	IF( CRT.NE.2 ) THEN
     	    CALL IFANSI_VIDEO(47)
     	ELSE
     	    CALL IFANSI_VIDEO(50)
     	ENDIF
     	WRITE(6,4000)
4000	FORMAT(' oops:'//' Auxiliary_commands: HELP/PF2,',
     +' DCL_PROMPT/PF4, REFRESH/PF1, EXIT, QUIT')
C
C  INSERT THE CURRENT PARAMETERS...
C
     	CALL FUNPLT_DATA(0)
     	RETURN
     	END

     	SUBROUTINE FUNPLT_DATA(ICODE)
C
C	THIS ROUTINE INSERTS PARAMETERS IN DIALOGUE MENU.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL

     	I = ICODE
     	CALL IFANSI_VIDEO(30)
     	IF( I.EQ.0 .OR. I.EQ.1 ) THEN
     	    IF(NFUN.GT.  0) CALL IFANSI_TEXT( FUNC(  1:), 77, 3, 4 )
     	    IF(NFUN.GT. 77) CALL IFANSI_TEXT( FUNC( 78:), 77, 4, 4 )
     	    IF(NFUN.GT.154) CALL IFANSI_TEXT( FUNC(155:), 77, 5, 4 )
     	    IF(NFUN.GT.231) CALL IFANSI_TEXT( FUNC(232:), 77, 6, 4 )
     	    IF(NFUN.GT.308) CALL IFANSI_TEXT( FUNC(309:), 77, 7, 4 )
     	ENDIF

     	IF(I.EQ.0.OR.I.EQ.2) CALL IFANSI_GFL(CS(1),1,12.5, 9,4 )
     	IF(I.EQ.0.OR.I.EQ.3) CALL IFANSI_GFL(CS(2),1,12.5, 9,20)
     	IF(I.EQ.0.OR.I.EQ.4) CALL IFANSI_GFL(CS(3),1,12.5, 9,36)
     	IF(I.EQ.0.OR.I.EQ.5) CALL IFANSI_GFL(CS(4),1,12.5, 9,52)
     	IF(I.EQ.0.OR.I.EQ.6) CALL IFANSI_GFL(CS(5),1,12.5, 9,68)
     	IF(I.EQ.0.OR.I.EQ.7) CALL IFANSI_GFL(CS(6),1,12.5,10,4 )
     	IF(I.EQ.0.OR.I.EQ.8) CALL IFANSI_GFL(CS(7),1,12.5,10,20)
     	IF(I.EQ.0.OR.I.EQ.9) CALL IFANSI_GFL(CS(8),1,12.5,10,36)
     	IF(I.EQ.0.OR.I.EQ.10)CALL IFANSI_GFL(CS(9),1,12.5,10,52)
     	IF(I.EQ.0.OR.I.EQ.11)CALL IFANSI_GFL(CS(10),1,12.5,10,68)

     	IF(I.EQ.0.OR.I.EQ.12) CALL IFANSI_TEXT(FNAME,32,12,4)
     	IF(I.EQ.0.OR.I.EQ.13) CALL IFANSI_TEXT(DNAME,32,13,4)
     	IF(I.EQ.0.OR.I.EQ.14) THEN
     	   CALL IFANSI_IFL (NPTX,1,4,14,4)
     	   CALL IFANSI_TEXT('                            ',28,14,8)
     	ENDIF
     	IF(I.EQ.0.OR.I.EQ.15) THEN
     	   CALL IFANSI_GFL(XBEG,1,15.8,15,4)
     	   CALL IFANSI_GFL(XEND,1,15.8,15,21)
     	ENDIF

     	IF(I.EQ.0.OR.I.EQ.16) THEN
     	   CALL IFANSI_IFL (NPTY,1,4,16,4)
     	   CALL IFANSI_TEXT('                            ',28,16,8)
     	ENDIF
     	IF(I.EQ.0.OR.I.EQ.17) THEN
     	   CALL IFANSI_GFL(YBEG,1,15.8,17,4)
     	   CALL IFANSI_GFL(YEND,1,15.8,17,21)
     	ENDIF

     	RETURN
     	END

     	SUBROUTINE FUNPLT_COM( IK, COMM )
C
C	THIS ROUTINE IMPLEMENTS SOME COMMANDS FOR FUNCTION PLOT.
C
     	CHARACTER TEXT*32, COMM*(*)

     	IKEY = IK
     	TEXT = COMM
     	CALL IFMISC_UPPER(TEXT)
     	IF( TEXT(1:3).EQ.'REF'
     + .OR. (IKEY.EQ.27 .AND. TEXT(1:2).EQ.'OP') ) THEN
     	    CALL FUNPLT_MENU
     	ELSE IF( TEXT(1:4).EQ.'HELP'
     + .OR. (IKEY.EQ.27 .AND. TEXT(1:2).EQ.'OQ') ) THEN
     	    NCHS = IFMISC_TYPE( 'GRAFIT$HLP:FUNPLT.HLP', ' ', 21 )
     	    IF( NCHS.EQ.0 ) THEN
     		CALL FUNPLT_MENU
     	    ELSE
     		CALL IFANSI_VIDEO(70)
     		CALL FUNPLT_OOPS(' HELP file is not available.')
     	    ENDIF
     	ELSE IF( TEXT(1:3).EQ.'DCL'
     + .OR. (IKEY.EQ.27 .AND. TEXT(1:2).EQ.'OS') ) THEN
     	    CALL IFMISC_SPAWN( TEXT, 0 )
     	    CALL FUNPLT_MENU
     	ELSE
     	    IF( IKEY.NE.27 ) THEN
     		CALL FUNPLT_ERROR(2)
     	    ELSE
     		CALL IFANSI_VIDEO(70)
     		CALL FUNPLT_OOPS(' Undefined function key.')
     	    ENDIF
     	ENDIF
     	RETURN
     	END

     	SUBROUTINE FUNPLT_CALC
C
C	THIS ROUTINE CALCULATES THE MATH FUNCTION
C	BY SPAWNING A VMS FORTRAN SUBPROCESS.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL
     	CHARACTER AP*1
C
C  OPEN THE FORTRAN FILE...
C
     	OPEN( UNIT=1, FILE='MATH_FUNCTION.FOR', STATUS='UNKNOWN',
     +        CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=999 )
C
C  WRITE THE FORTRAN ROUTINE...
C
     	AP = CHAR(39)
     	ND = IFMISC_LENG( DNAME )
     	IF( XCAL .AND. YCAL ) GOTO 111
C
C  WRITE THE ROUTINE FOR X,Y PLOT...
C
     	IF( XCAL ) WRITE(1,1000) NPTX,NPTX, AP,DNAME,AP,AP,AP,AP,AP,
     + (I-1,CS(I),I=1,10), NPTX, XBEG, XEND, FUNC(1:64)
     	IF( YCAL ) WRITE(1,1000) NPTY,NPTY, AP,DNAME,AP,AP,AP,AP,AP,
     + (I-1,CS(I),I=1,10), NPTY, YBEG, YEND, FUNC(1:64)

1000	FORMAT(
     +  6X'PARAMETER PI=3.1415926E+00,NA=6.022045E+23,KC=1.380662E-23'/
     +  6X'PARAMETER EC=1.6021892E-19,EA=4.803250E-10,BM=9.274078E-24'/
     +  6X'PARAMETER CC=2.9979246E+10,FC=9.648456E+04,HC=6.626176E-34'/
     +  6X'PARAMETER DR=1.7453292E-02'/
     +  '      DIMENSION XC(',I4,'), YC(',I4,')'/
     +  '      OPEN(1,FILE=',A1,A<ND>,A1,',STATUS=',A1,'NEW',A1,
     +  ',FORM=',A1,'UNFORMATTED',A1,')'/
     +  10('      C',I1,' = ',G12.5,/)
     +  '      NPTS = ',I4,/
     +  '      XBEG = ',G13.6,/
     +  '      XEND = ',G13.6,/
     +  '      STEP = (XEND-XBEG)/(NPTS-1)'/
     +  '      XBEG = XBEG - STEP'/
     +  '      DO I=1, NPTS'/
     +  '         X = XBEG + I*STEP'/
     +  '         XC(I) = X'/
     +  '      YC(I)=',A64)

     	IF( NFUN.GT. 64 ) WRITE(1,1001) FUNC( 65:130)
     	IF( NFUN.GT.130 ) WRITE(1,1001) FUNC(131:196)
     	IF( NFUN.GT.196 ) WRITE(1,1001) FUNC(197:262)
     	IF( NFUN.GT.262 ) WRITE(1,1001) FUNC(263:328)
     	IF( NFUN.GT.328 ) WRITE(1,1001) FUNC(329:385)
1001	FORMAT('     +',A66)

     	WRITE(1,1002)
1002	FORMAT(
     +  '      ENDDO'/
     +  '      WRITE(1) NPTS'/
     +  '      WRITE(1) (XC(I),I=1,NPTS)'/
     +  '      WRITE(1) (YC(I),I=1,NPTS)'/
     +  '      CLOSE(1)'/
     +  '      CALL EXIT'/
     +  '      END')
     	GOTO 888
C
C  WRITE THE ROUTINE FOR CONTOUR PLOT...
C
 111	IF( NPTX.GT.100 ) NPTX = 100
     	IF( NPTY.GT.100 ) NPTY = 100
     	WRITE(1,2000) NPTX*NPTY, AP,DNAME,AP,AP,AP,AP,AP,
     + (I-1,CS(I),I=1,10), NPTX,XBEG,XEND,NPTY,YBEG,YEND, FUNC(1:64)

2000	FORMAT(
     +  6X'PARAMETER PI=3.1415926E+00,NA=6.022045E+23,KC=1.380662E-23'/
     +  6X'PARAMETER EC=1.6021892E-19,EA=4.803250E-10,BM=9.274078E-24'/
     +  6X'PARAMETER CC=2.9979246E+10,FC=9.648456E+04,HC=6.626176E-34'/
     +  6X'PARAMETER DR=1.7453292E-02'/
     +  '      DIMENSION Z(',I5,')'/
     +  '      OPEN(1,FILE=',A1,A<ND>,A1,',STATUS=',A1,'NEW',A1,
     +  ',FORM=',A1,'UNFORMATTED',A1,')'/
     +  10('      C',I1,' = ',G12.5,/)
     +  '      NPTX = ',I4,/
     +  '      XBEG = ',G13.6,/
     +  '      XEND = ',G13.6,/
     +  '      XTEP = (XEND-XBEG)/(NPTX-1)'/
     +  '      NPTY = ',I4,/
     +  '      YBEG = ',G13.6,/
     +  '      YEND = ',G13.6,/
     +  '      YTEP = (YEND-YBEG)/(NPTY-1)'/
     +  '      IJ = 0'/
     +  '      DO I=0, NPTY-1'/
     +  '         DO J=0, NPTX-1'/
     +  '            IJ = IJ + 1'/
     +  '            X = XBEG + J*XTEP'/
     +  '            Y = YBEG + I*YTEP'/
     +  '      Z(IJ)=',A64)

     	IF( NFUN.GT. 64 ) WRITE(1,2001) FUNC( 65:130)
     	IF( NFUN.GT.130 ) WRITE(1,2001) FUNC(131:196)
     	IF( NFUN.GT.196 ) WRITE(1,2001) FUNC(197:262)
     	IF( NFUN.GT.262 ) WRITE(1,2001) FUNC(263:328)
     	IF( NFUN.GT.328 ) WRITE(1,2001) FUNC(329:385)
2001	FORMAT('     +',A66)

     	WRITE(1,2002)
2002	FORMAT(
     +  '         ENDDO'/
     +  '      ENDDO'/
     +  '      WRITE(1) XBEG, XEND, NPTX, YBEG, YEND, NPTY'/
     +  '      WRITE(1) (Z(I),I=1,IJ)'/
     +  '      CLOSE(1)'/
     +  '      CALL EXIT'/
     +  '      END')
C
C  SPAWN THE FORTRAN...
C
 888	CLOSE(UNIT=1)
     	IF( FNAME.NE.' ' ) CALL FUNPLT_IO(0)
     	CALL IFMISC_SPAWN( '$ @GRAFIT$EXE:GRAFIT.FUN', 0 )
     	NFUN = 0
     	FUNC = ' '
     	XCAL = .FALSE.
     	YCAL = .FALSE.
     	CALL FUNPLT_CLEAR_OOPS
 999	RETURN
     	END

     	FUNCTION FUNPLT_IO( ICODE )
C
C	THIS ROUTINE GETS/STORES USER MATH FUNCTION.
C
C	ICODE=0: STORE THE F(X,Y) FROM "FNAME"
C
C	ICODE=1: GET THE F(X,Y) FROM "FNAME"
C	FUNPLT_IO = 0.0: FAILED TO LOOK UP "FNAME".
C	FUNPLT_IO = 1.0: READ F(X,Y) SUCCESSFUL.
C
     	INTEGER   CRT
     	LOGICAL   XCAL, YCAL
     	CHARACTER DNAME*32, FNAME*32, FUNC*385
     	COMMON/FUNPLT_MENU/ NFUN, NPTX, XBEG, XEND, NPTY,
     +  YBEG, YEND, CS(10), FNAME, DNAME, FUNC, CRT, XCAL, YCAL

     	DIMENSION KP(2), RP(2)
     	CHARACTER KEY*3, KWD(17)*3, TEXT*80
     	DATA KWD / 'FZ=', '...', 'DF=', 'NX=', 'XR=', 'NY=', 'YR=',
     + 'C0=','C1=','C2=','C3=','C4=','C5=','C6=','C7=','C8=','C9=' /

     	IF( ICODE.NE.0 ) GOTO 111
C
C  STORE THE F(X,Y)...
C
     	OPEN( UNIT=13, FILE=FNAME, STATUS='UNKNOWN', ERR=888,
     +        CARRIAGECONTROL='LIST', FORM='FORMATTED' )

     			WRITE(13,2000,ERR=888) FUNC(  1: 77)
     	IF(NFUN.GT. 77) WRITE(13,2001,ERR=888) FUNC( 78:154)
     	IF(NFUN.GT.154) WRITE(13,2001,ERR=888) FUNC(155:231)
     	IF(NFUN.GT.231) WRITE(13,2001,ERR=888) FUNC(232:308)
     	IF(NFUN.GT.308) WRITE(13,2001,ERR=888) FUNC(309:385)
2000	FORMAT('FZ=',A77)
2001	FORMAT('...',A77)

     	WRITE(13,2002,ERR=888) DNAME,NPTX,XBEG,XEND,NPTY,YBEG,YEND
     +, (CS(I),I=1,10)
2002	FORMAT(
     +  'DF=',A32,/'NX=',I5,/'XR=',2G14.6,/'NY=',I5,/'YR=',2G14.6,/
     +  'C0=',G12.5/'C1=',G12.5/'C2=',G12.5/'C3=',G12.5/'C4=',G12.5/
     +  'C5=',G12.5/'C6=',G12.5/'C7=',G12.5/'C8=',G12.5/'C9=',G12.5)
     	GOTO 999
C
C  GET THE F(X,Y)...
C
111	OPEN( UNIT=13, FILE=FNAME, STATUS='OLD', ERR=888,
     +        CARRIAGECONTROL='LIST', READONLY, FORM='FORMATTED' )

     	MFUN = 0
222	READ(13,223,ERR=555,END=555) KEY,TEXT
223	FORMAT(A3,A80)
     	IF( KEY.EQ.' ' .OR. TEXT.EQ.' ' ) GOTO 222

     	DO IK=1, 17
     	   IF( KEY.EQ.KWD(IK) ) GOTO 333
     	ENDDO
     	GOTO 222

333	NCHS = IFMISC_STRIP(TEXT)
     	CALL   IFMISC_UPPER(TEXT)
     	IF( IK.LT.3 ) THEN
     	    DO  I=1, NCHS
     		IF( TEXT(I:I).NE.' ' ) THEN
     		    MFUN = MFUN + 1
     		    FUNC(MFUN:MFUN) = TEXT(I:I)
     		ENDIF
     	    ENDDO
     	    GOTO 222
     	ENDIF

     	IF( IK.EQ.3 ) THEN
     	    DNAME = TEXT
     	    GOTO 222
     	ENDIF

     	IF( IK.EQ.4 ) THEN
     	    NCHS = IFMISC_DECODE( TEXT, 1, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 222
     	    IF( RP(1).GT.1 .AND. RP(1).LT.9999 ) NPTX = RP(1)
     	    GOTO 222
     	ENDIF

     	IF( IK.EQ.5 ) THEN
     	    NCHS = IFMISC_DECODE( TEXT, 2, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 222
     	    XBEG = RP(1)
     	    XEND = RP(2)
     	    GOTO 222
     	ENDIF

     	IF( IK.EQ.6 ) THEN
     	    NCHS = IFMISC_DECODE( TEXT, 1, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 222
     	    IF( RP(1).GT.1 .AND. RP(1).LT.9999 ) NPTY = RP(1)
     	    GOTO 222
     	ENDIF

     	IF( IK.EQ.7 ) THEN
     	    NCHS = IFMISC_DECODE( TEXT, 2, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 222
     	    YBEG = RP(1)
     	    YEND = RP(2)
     	    GOTO 222
     	ENDIF

     	IF( IK.GT.7 ) THEN
     	    NCHS = IFMISC_DECODE( TEXT, 1, RP, KP )
     	    IF( NCHS.EQ.0 ) GOTO 222
     	    CS(IK-7) = RP(1)
     	    GOTO 222
     	ENDIF
     	GOTO 222

555	IF( MFUN.GT.0 ) THEN
     	    NFUN = MFUN
     	    CALL FUNPLT_FXY
     	ENDIF
     	GOTO 999

888	CLOSE(UNIT=13)
     	FUNPLT_IO = 0.0
     	RETURN
999	CLOSE(UNIT=13)
     	FUNPLT_IO = 1.0
     	RETURN
     	END

     	SUBROUTINE FUNPLT_ERROR( ICODE )
     	CHARACTER ERROR*75

     	I = ICODE
     	IF(I.EQ.1) ERROR = ' Undefined keyword.'
     	IF(I.EQ.2) ERROR = ' Undefined command.'
     	IF(I.EQ.3) ERROR = ' Invalid parameter input.'
     	IF(I.EQ.4) ERROR = ' Input parameter out of range.'
     	IF(I.EQ.5) ERROR = ' Missing parameter in the input.'
     	IF(I.EQ.6) ERROR = ' X-coordinate range not yet specified.'
     	IF(I.EQ.7) ERROR = ' Y-coordinate range not yet specified.'
     	IF(I.EQ.8) ERROR = ' Can not find/open the file.'
     	IF(I.EQ.9) ERROR = ' Missing X or Y variable in input F(X,Y).'
     	CALL IFANSI_VIDEO(70)
     	CALL FUNPLT_OOPS( ERROR )
     	RETURN
     	END

     	SUBROUTINE FUNPLT_OOPS( TEXT )
     	CHARACTER TEXT*(*)
     	NCHS = IFMISC_LENG(TEXT)
     	CALL IFANSI_TEXT( TEXT, NCHS, 19, 6 )
     	RETURN
     	END

     	SUBROUTINE FUNPLT_CLEAR_OOPS
     	CALL IFANSI_CURSOR(19,6)
     	CALL IFANSI_CLEAR(4)
     	RETURN
     	END

