C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
      CHARACTER*40 D
      CHARACTER*10 CLR
      COMMON/SCLA/WX,WY,EO,EM,XM,YM,DDOS,DOSM
	  IFIL=98
      CALL AYPSTR(IFIL)
      CALL AYORIG(40.0,40.0)
      READ(5,*) EO,EM,XM,YM,DDOS,DOSM,EF,ISPIN
      WX=XM/(EM-EO)
      WY=YM/DOSM
      CALL PLOTAX
         write(6,*) ' end of PLOTAX'
      CALL PLTDOS(ISPIN)
      CALL FERMIL(EF)
         write(6,*) ' end of FERMIL'
      READ(5,'(A40)') D
      CALL TITLE(D,40)
         write(6,*) ' end of TITLE'
      CALL AYPEND
      STOP
      END
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
      SUBROUTINE FERMIL(EF)
      COMMON/SCLA/WX,WY,EO,EM,XM,YM,DDOS,DOSM
      X=(EF-EO)*WX
      CALL SETDAS(5,3,1)
      CALL MOVETO(X,0.0)
      CALL LINETO(X,YM)
      RETURN
      END
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
      SUBROUTINE PLTDOS(ISPIN)
      COMMON/SCLA/WX,WY,EO,EM,XM,YM,DDOS,DOSM
      REAL*8 DD(9901),SS(9901),E0,DE,ELECN
      READ(13,3001) NNEE,NB1,NB2,NSPIN,E0,DE,ELECN
      WRITE(6,3001) NNEE,NB1,NB2,NSPIN,E0,DE,ELECN
 3001 FORMAT(4I5,3F10.5)
      DO 43 ISPI=1,NSPIN
	  IB=0
      DO 44 JB=NB1,NB2
	  IB=IB+1
      READ(14,*) ISP,NB,JFIRST,LASTP
      WRITE(6,*) ISP,NB,JFIRST,LASTP
	  IF(ISP.NE.ISPI) THEN
	     WRITE(6,*) ' ISP=',ISP,' .NE. ISPI=',ISPI
		 STOP
	  END IF
      IF(NB.NE.JB) THEN
	     WRITE(6,*) ' NB=',NB,'.NE.JB=',JB
		 STOP
      END IF		 
      READ(14,3000) (DD(I),I=JFIRST,LASTP)
	  READ(14,3000) (SS(I),I=JFIRST,LASTP)
 3000 FORMAT(6E12.5)
      IF(ISP.NE.ISPIN) GO TO 44
	  CALL LINEWD(1.0+IB*0.01)
	  CALL MOVETO(0.0,0.0)
	  DO 45 I=JFIRST,LASTP
	     E=E0+DE*(I-1)
		 IF(E.LT.EO) GO TO 45
		 IF(E.GT.EM) GO TO 45
		 X=(E-EO)*WX
		 Y=DD(I)*WY
		 CALL LINETO(X,Y)
   45 CONTINUE
       WRITE(6,*) ' END OF LINE FOR BAND=',NB,' ISPIN=',ISPIN  
   44 CONTINUE
      CALL LINETO(XM,0.0)
   43 CONTINUE
      CALL LINEWD(1.111) 
      DO 51 ISPI=1,NSPIN
	     READ(13,3000) (DD(I),I=1,NNEE)
		 IF(ISPI.NE.ISPIN) GO TO 51
		 CALL MOVETO(0.0,0.0)
		 DO 52 I=1,NNEE
		   E=E0+DE*(I-1)
		   IF(E.LT.EO) GO TO 52
		   IF(E.GT.EM) GO TO 53
		   X=(E-EO)*WX
		   Y=DD(I)*WY
		   CALL LINETO(X,Y)
   52   CONTINUE
   53   CONTINUE
        CALL LINETO(XM,0.0)
   51 CONTINUE
       WRITE(6,*) ' END OF LINE FOR TOTAL ISPIN=',ISPIN   
      RETURN
      END
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
c
      SUBROUTINE TITLE(D,K)
      COMMON/SCLA/WX,WY,EO,EM,XM,YM,DDOS,DOSM
      CHARACTER*40 D
      write(6,*) D
      CALL AWRITE(25,D,K,2.0,YM+5.0,0.0)
      RETURN
      END
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
c
      SUBROUTINE PLOTAX
C***********************************************************************
C PLOT FRAMES AND SCALES                                               *
C***********************************************************************
      COMMON/SCLA/WX,WY,EO,EM,XM,YM,DDOS,DOSM
      CALL MOVETO(0.0,0.0)
      CALL LINETO(XM,0.0)
      CALL LINETO(XM,YM)
      CALL LINETO(0.0,YM)
      CALL LINETO(0.0,0.0)
      ESDV=0.1
      IF(EM-EO.GT.1.0) ESDV=0.2
	  IF(EM-EO.GT.0.3.AND.EM-EO.LE.1.0) ESDV=0.05
	  IF(EM-EO.GT.0.1.AND.EM-EO.LE.0.3) ESDV=0.02
      IF(EM-EO.LE.0.1) ESDV=0.01
      E0A=(EO-0.000001)/ESDV
      IF(E0A.GE.0.0) I0=INT(E0A)+1
      IF(E0A.LT.0.0) I0=INT(E0A)
      EMA=(EM+0.000001)/ESDV
      IF(EMA.GE.0.0) IM=INT(EMA)
      IF(EMA.LT.0.0) IM=INT(EMA)-1
      WRITE(6,*) IM,I0,ESDV,E0A,EMA
      DO 100 I=1,IM-I0+1
      E=(I0+I-1)*ESDV
      X=(E-EO)*WX
      CALL MOVETO(X,0.0)
      CALL LINETO(X,-3.0)
  101 IF(ESDV.GE.0.1)
     &CALL FLWRIT(18,E,4,1,X-5.0,-10.0,0)
      IF(ESDV.LT.0.1)
     &CALL FLWRIT(18,E,5,2,X-5.0,-10.0,0)
  100 CONTINUE
      CALL AWRITE(20,'Energy (Ry.)',12,XM*0.4,-20.0,0.0)
      NY=(DOSM+0.1)/DDOS
      DO 10 I=1,NY
        IDOS=DDOS*I+0.5
        Y=WY*IDOS
        write(6,*) I,IDOS,Y,WY
        CALL MOVETO(0.0,Y)
        CALL LINETO(-3.0,Y)
        CALL IWRITE(18,IDOS,4,-15.0,Y-2.0,0.0)
   10 CONTINUE
      CALL AWRITE(20,'States/Ry.',10,-17.0,YM*0.4,90)
	   CALL MOVETO(0.0,0.0)
      RETURN
      END
 
