     	SUBROUTINE MAPLOT_PLOT
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY
C
C	THIS ROUTINE CARRIES OUT CONTOURING FOR CONTOUR PLOT.
C
     	INCLUDE 'MAPLOT.CBS'
C
C  MAKE SURE THE AXIS SCALES ARE OK...
C
     	IF( XINC(1).EQ.0.0 .OR. XINC(2).EQ.0.0 ) THEN
     	    IF( IF_DCL_HARDCOPY() ) THEN
     		STOP '%MAPLOT_PLOT: X,Y axis scaling failure.'
     	    ELSE
     		CALL IFANSI_VIDEO(70)
     		WRITE(6,1000)
 1000		FORMAT(' oops: X,Y axis scaling failure.')
     	    ENDIF
     	    RETURN
     	ENDIF
C
C  INITIALIZE THE CRT...
C
     	CALL IFANSI_VIDEO(47)
     	CALL IFINIT_LINE( 3 )
     	IF( INIT ) THEN
     	    CALL IFINIT_PLOT( XORG, YORG, DATNAM )
     	ELSE
     	    CALL IFINIT_PLOT( XORG, YORG, '$OVERLAY' )
     	ENDIF
     	IF( IFCTRL_C() ) GOTO 999
C
C  OPEN A GRAPHICS SEGMENT TO SAVE THE PLOT...
C
     	IF( .NOT.IFINIT_SAVE() ) RETURN
     	IF( .NOT.IF_DCL_HARDCOPY() ) WRITE(6,1)
  1	FORMAT('$Press CTRL/C to cancel plotting...')
     	CALL IFINIT_DIF(0)
     	CALL IFSCAL( XSCL, YSCL )
     	CALL IFINIT_DIF(1)
     	CALL IFROTA( XANG(1), XANG(2) )
C
C  DRAW GRAPH TITLE IF ANY...
C
     	IF( TITL(1).NE.' ' ) THEN
     	    CALL IFSPEN(1)
     	    CALL IFTEXT_CENT(0.,ABS(XLNS(1)),-1.,-1.,TITL(1),0.15,0.15)
     	ENDIF
C
C  DRAW THE X,Y AXES...
C
     	CALL IFSPEN( IAXS ) 
     	IF( XLNS(1).GT.0 ) THEN
     	IF( IFCTRL_C() ) GOTO 999
     	    IF( SOFF(1).NE.0.0 ) CALL IFPLOT( 0.0, SOFF(1), -3 )
     	    CALL IFAXIS( 1, XLNS(1), ABS(XLNS(2)), TITL(2), XLOW(1),
     +      XINC(1), OFFS(1), NTKS(1), MTKS(1), NDGS(1), IGDS(1) )
     	    IF( SOFF(1).NE.0.0 ) CALL IFPLOT( 0.0, -SOFF(1), -3 )
     	ENDIF
     	IF( XLNS(2).GT.0 ) THEN
     	IF( IFCTRL_C() ) GOTO 999
     	    IF( SOFF(2).NE.0.0 ) CALL IFPLOT( SOFF(2), 0.0, -3 )
     	    CALL IFAXIS( 4, ABS(XLNS(1)), XLNS(2), TITL(3), XLOW(2),
     +      XINC(2), OFFS(2), NTKS(2), MTKS(2), NDGS(2), IGDS(2) )
     	    IF( SOFF(2).NE.0.0 ) CALL IFPLOT( -SOFF(2), 0.0, -3 )
     	ENDIF
C
C  DRAW THE CONTOURS...
C
     	IF( IFCTRL_C() ) GOTO 999
     	CALL MAPLOT_DRAW(1)			!1ST MAP
     	IF( IFCTRL_C() ) GOTO 999
     	IF( ADDNAM.NE.' ' ) CALL MAPLOT_DRAW(2)	!2ND MAP
C
C  DRAW THE LABEL BOX IF DESIRED...
C
     	CALL IFSTYL( 1, 1 )
     	CALL IFSPEN( 1 )
     	IF( DRAW.EQ.2 ) CALL MAPLOT_DRAW_BOX( XLPS, YLPS )
C
C  CLOSE THE PLOT SESSION...
C
     	IF( CRT.EQ.2 ) CALL IFSEG_OPEN( 0 ) 	!CLOSE THE SEGMENT
     	IF( IFCTRL_C() ) GOTO 999
    	IF( DESNAM.NE.' ' ) CALL LAYOUT_MAIN(0,XORG,YORG,DESNAM)
  999	CALL IFINIT_PLOT_END
     	RETURN
    	END

     	SUBROUTINE MAPLOT_DRAW( MAP )
C
C 	THIS ROUTINE CONTOURS THE MAPS.
C
     	INCLUDE   'MAPLOT.CBS'
     	COMMON/MAPLOT_DRAW/ XPOS, YPOS, LMAX
     	COMMON/GRAFIT_SCRATCH/ Z(MNG,MNG)

     	KM = MAP
     	IF( KM.EQ.1 ) THEN
     	    XPOS = XLPS + 0.15
     	    YPOS = YLPS + 0.15
     	    LMAX = 3
     	ENDIF
C
C  LOAD THE MAP DATA...
C
     	CALL MAPLOT_LOAD( KM, NC, NR )
C
C  EXPAND THE MAP IF DESIRED...
C
     	I = NEXP(KM)
     	IF( I.GT.0 ) THEN
     	    IF( I*NC.GT.MNG ) I = MNG/NC
     	    IF( I*NR.GT.MNG ) I = MNG/NR
     	    CALL IFMISC_MAP_EXPAND( I, MNG, NC, NR, Z(1,1) )
     	    NEXP(KM) = I
     	ENDIF
C
C  CONTOUR THE MAP LEVEL BY LEVEL...
C
     	DO  I=1, 7
     	IF( IFCTRL_C() ) RETURN
     	    IF( CPEN(I,KM).GT.0 ) THEN
     		J = MNG
     		K = LINE(I,KM)
     		IF( K.LT.0 ) J = -J
     		CALL IFSPEN( CPEN(I,KM) )
     		CALL IFSTYL( IABS(K), BOLD(I,KM) )
     		CALL IFMISC_MAP( J, NC, NR, CLEV(I,KM), Z(1,1),
     +               FILL(I,KM), ABS(XLNS(1)), ABS(XLNS(2)) )
     	IF( IFCTRL_C() ) RETURN
     		IF(DRAW.GT.0) CALL MAPLOT_LABEL( CLEV(I,KM) )
     	    ENDIF
     	ENDDO
C
C  MARK MIN AND MAX CONTOUR POINTS IF DESIRED...
C
	IF( MARK.GT.0 ) CALL MAPLOT_MARK( KM, NC, NR )
     	RETURN
     	END

     	SUBROUTINE MAPLOT_LOAD( MAP, NC, NR )
C
C	THIS ROUTINE LOADS THE MAP DATA FOR CONTOURING.
C
     	INCLUDE 'MAPLOT.CBS'
     	COMMON/GRAFIT_SCRATCH/ Z(MNG,MNG)
C
C  GET THE INITIAL AND THE ENDING COLUMNS AND ROWS TO CONTOUR...
C
     	KM  = MAP
     	IC1 = 1
     	IC2 = NCOL
     	IR1 = 1
     	IR2 = NROW
	IF(XLOW(1).GT.XBND(1,1)) IC1=(XLOW(1)-XBND(1,1))/XBND(3,1)+1.1
     	IF(XHIG(1).LT.XBND(2,1)) IC2=(XHIG(1)-XBND(1,1))/XBND(3,1)+1.1
	IF(XLOW(2).GT.XBND(1,2)) IR1=(XLOW(2)-XBND(1,2))/XBND(3,2)+1.1
     	IF(XHIG(2).LT.XBND(2,2)) IR2=(XHIG(2)-XBND(1,2))/XBND(3,2)+1.1
C
C  LOAD THE MAP...
C
     	CM = CMAP(KM)
     	JK = 0
     	DO  J= IR1, IR2
     	    JK = JK + 1
     	    IK = 0
     	    DO  I= IC1, IC2
     		IK = IK + 1			!CONTOUR ROUTINE TAKES
     		Z(JK,IK) = ZMAP(I,J,KM)*CM	!Z(Y,X) AS DEFAULT.
     	    ENDDO
     	ENDDO
     	NC = IK
     	NR = JK

     	RETURN
     	END

     	SUBROUTINE MAPLOT_LABEL( CLV )
C
C	THIS ROUTINE DRAWS THE CONTOUR LEVEL LABELS.
C
     	INCLUDE 'MAPLOT.CBS'
     	COMMON/MAPLOT_DRAW/ XPOS, YPOS, LMAX
     	CHARACTER LABEL*12

     	IF( CLV.NE.0.0 ) THEN
     	    IF( LDIG.GT.5 ) LDIG = 5
     	    ENCODE( LDIG+7, 111, LABEL ) CLV
111	    FORMAT(G<LDIG+7>.<LDIG>)
     	    NCH = MAPLOT_STRIP( LDIG+7, LABEL )
     	    IF( NCH.GT.LMAX ) LMAX = NCH
     	ELSE
     	    LABEL = '0.0'
     	ENDIF
     	CALL IFTEXT( XPOS+0.05, YPOS, LABEL, 0.1, 0.1, 0 )
     	CALL IFPLOT( XPOS, YPOS-0.03, 3 )
     	CALL IFPLOT( XPOS+0.5, YPOS-0.03, 2 )
     	YPOS = YPOS + 0.25

     	RETURN
     	END

     	SUBROUTINE MAPLOT_DRAW_BOX( XPS, YPS )
C
C	THIS ROUTINE DRAWS A BOX AROUND THE CONTOUR LEVEL LABELS.
C
     	COMMON/MAPLOT_DRAW/ XPOS, YPOS, LMAX

     	XPOS = 0.8
     	IF( LMAX.GT.5 ) XPOS = 0.3 + 0.1*LMAX
     	XLPS = XPS
     	YLPS = YPS
     	XPOS = XPOS + XLPS
     	CALL IFPLOT( XLPS, YLPS, 3 )
     	CALL IFPLOT( XLPS, YPOS, 2 )
     	CALL IFPLOT( XPOS, YPOS, 2 )
     	CALL IFPLOT( XPOS, YLPS, 2 )
     	CALL IFPLOT( XLPS, YLPS, 2 )

     	RETURN
     	END

     	SUBROUTINE MAPLOT_MARK( MAP, NC, NR )
C
C	THIS ROUTINE MARKS THE MIN AND MAX POINTS ON THE MAP.
C
     	INCLUDE   'MAPLOT.CBS'
     	CHARACTER LABEL*12
     	COMMON/GRAFIT_SCRATCH/ Z(MNG,MNG)
C
C  SEARCH FOR MIN AND MAX POINTS IN THE MAP...
C
     	KM = MAP
     	KC = NC
     	KR = NR
     	CX = -1.7E38
     	CM =  1.7E38
     	DO  J=1, KC
     	    DO  I=1, KR
     		CMX = Z(I,J)
     		IF( CMX.GT.CX ) THEN
     		    CX = CMX
     		    IC = J
     		    IR = I
     		ENDIF
     		IF( CMX.LT.CM ) THEN
     		    CM = CMX
     		    JC = J
     		    JR = I
     		ENDIF
     	    ENDDO
     	ENDDO
C
C  MARK THE MAXIMUM POINT WITH A SOLID TRIANGLE...
C
     	XPS = ABS(XLNS(1))*FLOAT(IC-1)/FLOAT(KC-1)
     	YPS = ABS(XLNS(2))*FLOAT(IR-1)/FLOAT(KR-1)
     	IPN = 3
     	CMX = -1.7E38
     	DO  I=1, 7
     	    IF( CPEN(I,KM).GT.0 .AND. CLEV(I,KM).GT.CMX ) THEN
     		CMX = CLEV(I,KM)
     		IPN = CPEN(I,KM)
     	    ENDIF
     	ENDDO
     	CALL IFSPEN( IPN )
     	CALL IFMARK( XPS, YPS, 0.1, 0, 6 )
     	IF( CX.NE.0.0 ) THEN
     	    ENCODE( LDIG+7, 111, LABEL ) CX
111	    FORMAT(G<LDIG+7>.<LDIG>)
     	    IPN = MAPLOT_STRIP( LDIG+7, LABEL )
     	ELSE
     	    LABEL = '0.0'
     	    IPN = 3
     	ENDIF
     	CALL IFTEXT( XPS-0.05*IPN, YPS+0.1, LABEL, 0.1, 0.1, 0 )
C
C  MARK THE MINIMUM POINT WITH A TRIANGLE...
C
     	XPS = ABS(XLNS(1))*FLOAT(JC-1)/FLOAT(KC-1)
     	YPS = ABS(XLNS(2))*FLOAT(JR-1)/FLOAT(KR-1)
     	IPN = 1
     	CMX = 1.7E38
     	DO  I=1, 7
     	    IF( CPEN(I,KM).GT.0 .AND. CLEV(I,KM).LT.CMX ) THEN
     		CMX = CLEV(I,KM)
     		IPN = CPEN(I,KM)
     	    ENDIF
     	ENDDO
     	CALL IFSPEN( IPN )
     	CALL IFMARK( XPS, YPS, 0.1, 0, 5 )
     	IF( CM.NE.0.0 ) THEN
     	    ENCODE( LDIG+7, 111, LABEL ) CM
     	    IPN = MAPLOT_STRIP( LDIG+7, LABEL )
     	ELSE
     	    LABEL = '0.0'
     	    IPN = 3
     	ENDIF
     	CALL IFTEXT( XPS-0.05*IPN, YPS+0.1, LABEL, 0.1, 0.1, 0 )

     	RETURN
     	END

     	FUNCTION MAPLOT_STRIP( NK, FNUM )
     	CHARACTER FNUM*(*)

     	K = NK
     	DO  I=1, K
     	    IF( FNUM(I:I).NE.' ' ) GOTO 1
     	ENDDO
  1	IF( I.GT.1 ) THEN
     	    FNUM = FNUM(I:)
     	    K = K-I+1
     	ENDIF
     	DO  I=K,1,-1
     	    IF( FNUM(I:I).NE.' ' ) GOTO 2
     	ENDDO
  2	K = I
     	I = INDEX( FNUM(1:K), 'E' )
     	IF( I.GT.0 ) K = I-1
     	DO  J=K,1,-1
     	    IF( FNUM(J:J).NE.'0' ) GOTO 3
     	ENDDO
  3	IF( FNUM(J:J).EQ.'.' ) J = J + 1
     	IF( I.GT.0 ) THEN
     	    FNUM(J+1:) = FNUM(I:)
     	    J = J + 4
     	ENDIF
     	FNUM(J:) = ' '
     	MAPLOT_STRIP = J
     	RETURN
     	END

