path: root/synthe/plotobsimcol.for

PROGRAM PLOTobsim
c     revised 23jan93
C     TAPE7 IS CALCULATED SPECTRUM
C     TAPE55 READ BY OBSERV
C     TAPE56 READ BY OBSERV1
C     TAPE57 READ BY OBSERV2
C     TAPE58 READ BY OBSENGV
C     TAPE59 READ BY OBSHALL
C     TAPE60 READ BY OBSKPNO
C     TAPE61 READ BY OBSKPK
C     TAPE62 READ BY OBSSACP
C     TAPE63 READ BY OBSHAWA
C     TAPE64 READ BY OBSNRL
C     TAPE65 READ BY OBSPROC
C     TAPE66 READ BY OBSSIR
C     TAPE67 READ BY OBSARC
C     TAPE68 READ BY OBSSUNF
C     TAPE69 READ BY OBSSOIR
C     TAPE71 READ BY OBSFTS2
C     TAPE72 READ BY OBSFTS2
C     TAPE73 READ BY OBSFTS
C     TAPE74 READ BY OBSJUNG
C     TAPE76 READ BY LABEL5  AFCRL LINE LIST
C     TAPE77 READ BY LABEL9  PIERCE AND BRECKENRIDGE
C     TAPE93 IS TEMPORARY STORAGE FOR LABEL DATA
C
C     IFLABL=N LINES ARE LABELLED.  A NUMBER N ENDING IN THE DIGIT I
C              PRODUCES A CALL TO SUBROUTINE LABELI
C           =1 NORMAL LABELS FOR CALCULATED SPECTRUM, 25/INCH, TWO ROWS
C           =11 NORMAL LABELS FOR CALCULATED SPECTRUM, 12.5/INCH, ONE ROW
C           =21 
C           =31 NORMAL LABELS FOR CALCULATED SPECTRUM, 12.5/INCH, 
C                   LOWER ROW ATOMS, UPPER ROW MOLECULES
C           =2
C           =3
C           =4
C           =5 LABEL AFCRL TERRESTRIAL LINES 25/INCH, TWO ROWS
C           =15 LABEL AFCRL TERRESTRIAL LINES 12.5/INCH, ONE ROW
C           =6
C           =7 NORMAL LABELS FOR CALCULATED OPACITY SPECTRUM, 25/INCH
C           =8
C           =9 LABEL PIERCE AND BRECKENRIDGE LINES
C     IFLABL=0 NO LABELS
C     IFABSO=0 THE PLOT IS IN RESIDUAL INTENSITY OR FLUX
C     IFABSO=1 THE PLOT IS IN ABSOLUTE UNITS
C     IFCONT=1 AND IFABSO=1 THE CONTINUUM IS PLOTTED
C     IFCONT=0 NO CONTINUUM
C     IFCONT=2 CONTINUUM USED FOR MAXIMUM BUT NOT PLOTTED
C     IFCONT=3 ONLY CONTINUUM IS PLOTTED
C     IFGRID=1 A BACKGROUND GRID IS PLOTTED IF XSCALE= 2.
C     IFDLINE=1 SPECTRUM LINES ARE DOUBLE WEIGHT
C     IFLOG=1 PLOT IS LOG WITH CYCLES CYCLES
C     IFLOG=0 PLOT IS LINEAR
C     JUST1=0 ALL PANELS ARE PLOTTED
C     JUST1 GREATER THAN 0 A TABLE OF SWITCHES FOR EACH PANEL IS READ
C     NOWAVE=1 DO NOT PUT WAVELENGTH IN BANNER AT ENDS OF PANELS
C     NOWAVE=0 PUT WAVELENGTH IN BANNER AT ENDS OF PANELS
C     IFNEWW CHANGE TO NEW STARTING AND STOPPING WAVELENGTHS AS READ IN
C     NOCALC=0 CALCULATIONS ARE TO BE READ
C     NOCALC=1  NO CALCULATIONS ARE TO BE READ  REQUIRES IFNEWW=1
C     IFDUM1 
C     IFNOAX=1  AXES ARE NOT LABELLED
C     IFNOAX=-1 AXES ARE LABELLED.  Y TWICE 0 TO 1 AND .9 TO 1
C     IFMU=0 PLOT FIRST ANGLE OR FLUX
C     IFMU=1 TO 20 PLOT ANGLE IFMU
C     NOPRNT=0 PRINT ALL LINE DATA
C     NOPRNT=1 NO PRINTING OF LINE DATA
C     NOPRNT=2 PRINT LINE DATA ONLY FOR LINES THAT ARE LABELLED
C     IFKPNO.GT.0 PLOT KITT PEAK PRELIMINARY SOLAR ATLAS
C     IFKPK.GT.0 PLOT KOHL, PARKINSON, AND KURUCZ SOLAR ATLAS
C     IFSACP.GT.0 PLOT SAC PEAK SOLAR FLUX ATLAS
C     IFHAWA.GT.0 PLOT HAWAII SOLAR ATLAS
C     IFNRL.GT.0 PLOT NRL SOLAR ATLAS
C     IFPROC.GT.0 PLOT GRIFFIN PROCYON ATLAS
C     IFDUM2
C     IFSIR.GT.0 PLOT FURENLID SIRIUS ATLAS
C     IFARC.GT.0 PLOT GRIFFIN ARCTURUS ATLAS
C     IFSUNF.GT.0 PLOT FURENLID AND KURUCZ SOLAR FLUX ATLAS
C     IFSOIR.GT.0 PLOT INFRARED FTS SOLAR ATLAS
C     IFHALL.GT.0 PLOT HALL INFRARED SUNSPOT ATLAS
C     IFENGV.GT.0 PLOT ENGVOLD SUNSPOT ATLAS
C     IFOPAC=N INPUT CALCULATED SPECTRUM IS MASS ABSORPTION COEFFICIENT
C              OUTPUT FROM SYNTHE.  USE ASYNTH(N).  PLOT MUST USUALLY BE LOG.
C     IFFTS.GT.0 PLOT AN FTS SPECTRUM FROM KITT PEAK
C     IFFTS2.GT.0 PLOT THE RATIO OF TWO FTS SPECTRA FROM KITT PEAK
C     IFJUNG.GT.0 PLOT JUNGFRAUJOCH SOLAR ATLAS
C     YSCALE IS THE HEIGHT OF THE PLOT IN MULTIPLES OF 3.125
C        DEFAULT=1. FOR XSCALE.GT.0 AND XSCALE.LT.1
C        DEFAULT=2. FOR XSCALE.GT.1
C        OTHERWISE YTOP=6.25
C     XSCALE=1.   10 IN/NM
C     XSCALE=2.   20 IN/NM
C     XSCALE=4.   40 IN/NM
C     XSCALE=8.   80 IN/NM
C     WEAK IS 1.-RESIDUAL INTENSITY OF THE WEAKEST LINES TO BE LABELED
C        IF WEAK = 0 ALL LINES ARE LABELED
C     PANEL IS MAXIMUM LENGTH OF EACH PLOT PANEL
C        AN ADDITIONAL .1NM IS ADDED FOR OVERLAP BETWEEN PANELS
C     CYCLES IS NUMBER OF CYCLES IF PLOT IS LOG
C     OFFSET IS THE NUMBER OF INCHES BY WHICH THE PLOT IS DISPLACED
C        VERTICALLY
C     RMIN IS THE RESIDUAL INTENSITY AT THE BOTTOM OF THE PLOT
C     RMAX IS THE RESIDUAL INTENSITY AT THE TOP OF THE PLOT. DEFAULT 1.
C     TOP FIXES THE VALUE OF THE TOP OF THE PLOT IF IFABSO = 1
C        IF TOP=0. THE TOP IS SET TO THE MAXIMUM VAUE IN EACH PANEL
C     WNEW1 IS A NEW STARTING WAVELENGTH
C     WNEW2 IS A NEW STOPPING WAVELENGTH
C     TICKTOP IS THE SIZE AND DIRECTION OF TICK MARKS AT THE TOP OF THE PLOT
C     TICKBOT IS THE SIZE AND DIRECTION OF TICK MARKS AT THE BOTTOM OF THE PLOT
C             DEFAULT IS -0.15 AND +0.15
C     SMOOTH IS A SMOOTHING PARAMETER TO BE TRANSMITTED TO OBS SUBROUTINES
C             IT WOULD GENERALLY BE THE FWHM IN POINT NUMBERS OF A GAUSSIAN
C             IF NEGATIVE IT IS THE CENTRAL WEIGHT FOR THREE POINT SMOOTHING
C     DOPOBS IS A DOPPLER SHIFT IN KM/S FOR THE OBSERVED SPECTRA
C     DOPCALC IS A DOPPLER SHIFT IN KM/S FOR THE CALCULATED SPECTRUM
C     DOPTERR IS A DOPPLER SHIFT IN KM/S FOR TERRESTRIAL SPECTRUM OR LABELS
C     SCALOBS IS A FACTOR BY WHICH AN OBSERVED SPECTRUM IS TO BE SCALED
C     ZEROOBS IS A ZERO LEVEL CORRECTION TO AN OBSERVED SPECTRUM
C     RMIN2 THE COMPUTED SPECTRUM IS PLOTTED TWICE, SECOND WITH RMIN2
C     RMAX2 THE COMPUTED SPECTRUM IS PLOTTED TWICE, SECOND WITH RMAX2
C     XOFFSET IS THE NUMBER OF INCHES THE PLOT IS DISPLACED IN X
C     SCALOB2 IF 0 = SCALOBS
C             IF NOT 0  SCALOBS IS THE SCALING FACTOR FOR THE BEGINNING AND
C                       SCALOB2 IS THE SCALING FACTOR FOR THE END AND 
C                       INTERMEDIATE VALUES ARE LINEARLY INTERPOLATED
C     DUMMY7
      COMMON /PARAMS/XSCALE,
     1               RMIN,WEAK,TOP,PANEL,CYCLES,WBEGIN,WEND,W1,W2,YTOP,
     2               HMAX,HMIN,YSCALE,OFFSET,RMAX,
     3               WNEW1,WNEW2,SMOOTH,DOPOBS,DOPCALC,DOPTERR,
     4               SCALOBS,ZEROOBS,RMIN2,RMAX2,XOFFSET,SCALOB2,IUERM,
     5               IFLABL,IFABSO,IFCONT,IFGRID,IFDLIN,IFLOG,IFMU,NOCALC
     6               IFVAC,NOPRNT
      REAL*8 WBEGIN,WEND,W1,W2,RESOLU,RATIO,WNEW1,WNEW2,WAVEL
      REAL*8 WAVE,WBEGDOP
      REAL*8 TITLE(74),XMU(20),WLEDGE(200),TEFF,GLOG
      COMMON /CELL/MAXCEL,IFCELL(40000)
      REAL*8 Q2(40)
C      REAL*4 MESSAGE(20,9),ASYNTH(64),TURBV,ALINEC(64)
      REAL*4 ASYNTH(64),TURBV,ALINEC(64)
      CHARACTER*79 MESSAGE(9)
      INTEGER VLO,VUP
CCRAY REAL*8 WORDS(3)
      REAL*4 WORDS(6)
      COMMON /LINDAT/WL,E,EP,LABEL(2),LABELP(2),OTHER1(2),OTHER2(2),
     1        WLVAC,CENTER,CONCEN, NELION,GAMMAR,GAMMAS,GAMMAW,REF,
     2      NBLO,NBUP,ISO1,X1,ISO2,X2,GFLOG,XJ,XJP,CODE,ELO,GF,GS,GR,GW,
     3        DWL,DGFLOG,DGAMMAR,DGAMMAS,DGAMMAW,EXTRA1,EXTRA2,EXTRA3
      REAL*8 LINDAT8(14)
      REAL*4 LINDAT(28)
      EQUIVALENCE (LINDAT8(1),WL),(LINDAT(1),NELION)
      REAL*8 RATIOLG,SIGMA2,WLBEG,WLEND
      REAL*8 WL,E,EP,WLVAC,CENTER,CONCEN
      REAL*8 LABEL,LABELP,OTHER1,OTHER2
      COMMON/COLOR/COLOROBS
      CHARACTER*10 COLOROBS
      DIMENSION IFPANL(80)
      COMMON /HEADERDATA/USERID(2),FILENAME(2),
     1 IDATE(3),ITIME(2),JOBID(2)
      REAL*8 USERID,FILENAME
      CHARACTER*9 HEADERDATA(5)
      CHARACTER*6 WW6,STRING6
      CHARACTER*9 STRING9
      DATA IFPANL/80*1/
C     CALL FILEREP
C      CALL BEGTIME
C     CALL RDYOUTF(6,0)
      IUERM=0
      READ(5,1001)IFLABL,IFABSO,IFCONT,IFGRID,IFDLIN,IFLOG,JUST1,NOWAVE,
     1NOCALC,IFDUM1
 1001 FORMAT(10I8)
      WRITE(6,1002)IFLABL,IFABSO,IFCONT,IFGRID,IFDLIN,IFLOG,JUST1,
     1NOWAVE,NOCALC,IFDUM1
 1002 FORMAT(1X,10I8/'   IFLABL  IFABSO  IFCONT  IFGRID  IFDLIN',
     1'   IFLOG   JUST1  NOWAVE  NOCALC  IFDUM1')  
      READ(5,1001)
      READ(5,1001)IFNOAX,IFMU,NOPRNT,IFKPNO,IFKPK,IFSACP,IFHAWA,IFNRL,
     1IFPROC,IFSIR
      WRITE(6,1003)IFNOAX,IFMU,NOPRNT,IFKPNO,IFKPK,IFSACP,IFHAWA,IFNRL,
     1IFPROC,IFDUM2
 1003 FORMAT(1X,10I8/'   IFNOAX    IFMU  NOPRNT  IFKPNO   IFKPK'
     1'  IFSACP  IFHAWA   IFNRL  IFPROC   IFDUM2')
      READ(5,1001)
      READ(5,1001)IFSIR,IFARC,IFSUNF,IFSOIR,IFHALL,IFENGV,IFOPAC,IFFTS,
     1IFFTS2,IFJUNG
      WRITE(6,1004)IFSIR,IFARC,IFSUNF,IFSOIR,IFHALL,IFENGV,IFOPAC,
     1IFFTS,IFFTS2,IFJUNG
 1004 FORMAT(1X,10I8/'    IFSIR   IFARC  IFSUNF  IFSOIR  IFHALL',
     1'  IFENGV  IFOPAC  IFFTS   IFFTS2  IFJUNG')
      READ(5,1001)
      READ(5,1005)YSCALE,XSCALE,WEAK,PANEL,CYCLES,OFFSET,RMIN,RMAX
 1005 FORMAT(8F10.3)
      WRITE(6,1006)YSCALE,XSCALE,WEAK,PANEL,CYCLES,OFFSET,RMIN,RMAX
 1006 FORMAT(1X,8F10.3/75H YSCALE    XSCALE    WEAK      PANEL     CYCLE
     1S    OFFSET    RMIN      RMAX)
      READ(5,1001)
      READ(5,1007)TOP,WNEW1,WNEW2,TICKTOP,TICKBOT,SMOOTH,DOPOBS,DOPCALC
 1007 FORMAT(E10.3,7F10.3)
      WRITE(6,1008)TOP,WNEW1,WNEW2,TICKTOP,TICKBOT,SMOOTH,DOPOBS,DOPCALC
 1008 FORMAT(1PE10.3,0P7F10.3/79H TOP       WNEW1     WNEW2     TICKTOP
     1  TICKBOT    SMOOTH    DOPOBS    DOPCALC    )
      READ(5,1001)
      READ(5,1027)DOPTERR,SCALOBS,ZEROOBS,RMIN2,RMAX2,XOFFSET,SCALOB2,
     1COLOROBS
 1027 FORMAT(7F10.3,A10)
      WRITE(6,1028)DOPTERR,SCALOBS,ZEROOBS,RMIN2,RMAX2,XOFFSET,SCALOB2,
     1COLOROBS
 1028 FORMAT(7F10.3,A10
	1 /' DOPTERR   SCALOBS   ZEROOBS   RMIN2     RMAX2 
     1  XOFFSET   SCALOB2   COLOROBS' )
      READ(5,1001)
      READ(5,1009)IFPANL
 1009 FORMAT(80I1)
      WRITE(6,1010)IFPANL
 1010 FORMAT(1X,80I1/81H 12345678901234567890123456789012345678901234567
     1890123456789012345678901234567890)
      READ(5,1001)
      MU=IFMU
      IF(IFMU.EQ.0)MU=1
      IF(JUST1.GT.0)GO TO 1020
      DO 1019 IPANEL=1,80
 1019 IFPANL(IPANEL)=1
 1020 CONTINUE
      READ(5,2)MESSAGE
    2 FORMAT(1X,A79)
      WRITE(6,2)MESSAGE
    5 CONTINUE
      IF(RMAX.EQ.0.)RMAX=1.
      IFRMAX2=0
      IF(RMIN2.NE.0.)IFRMAX2=1
      IF(RMAX2.NE.0.)IFRMAX2=1
      IF(RMAX2.EQ.0.)RMAX2=1.
      Y=YSCALE
      IF(XSCALE.EQ.0.)XSCALE=2.
      YSCALE=2.
      IF(XSCALE.LT.1.)YSCALE=1.
      IF(Y.GT.0.)YSCALE=Y
      IF(PANEL.EQ.0.)PANEL=5.
      IF(SCALOBS.EQ.0.)SCALOBS=1.
      IF(SCALOB2.EQ.0.)SCALOB2=SCALOBS
C     OPEN(UNIT=55,READONLY,SHARED,TYPE='OLD',FORM='UNFORMATTED')
      IF(NOCALC.EQ.1)GO TO 207
C     OPEN(UNIT=7,READONLY,SHARED,TYPE='OLD',FORM='UNFORMATTED')
      REWIND 7
      IF(IFOPAC.NE.0)GO TO 205
      READ(7)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU,NEDGE,
     1WLEDGE
      NMU2=NMU+NMU
      MUNMU=MU+NMU
      WRITE(6,4)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF
    4 FORMAT(F10.1,F10.3,3X,74A1/F12.4,F10.1,2I10)
      IFVAC=1
      IF(TITLE(74).EQ.1HA)IFVAC=0
C     WBEGIN IS THE FIRST CALCULATED WAVELENGTH
C     WSTART IS THE FIRST PLOTTED WAVELENGTH
      WSTART=WBEGIN
      RATIO=1.+1./RESOLU
      WEND=WBEGIN*RATIO**(NWL-1)
      IWEND=WEND*10.+.5
      WEND=FLOAT(IWEND)/10.
      IWSTART=WBEGIN*10.+.5
      WSTART=FLOAT(IWSTART)/10.
      IF(WNEW1.EQ.0.)WNEW1=WSTART
      IF(WNEW2.EQ.0.)WNEW2=WEND
      GO TO 207
  205 CONTINUE
      READ(7)WBEGIN,RESOLU,WLEND,NWL,NRHOX,LINOUT,TURBV,IFVAC
      READ(7)
      WRITE(6,214)WBEGIN,RESOLU,NWL,NRHOX,IFVAC
  214 FORMAT(F10.3,F10.1,3I10)
      IWSTART=WBEGIN*10.+.5
      WSTART=FLOAT(IWSTART)/10.
      RATIO=1.+1./RESOLU
      WEND=WBEGIN*RATIO**(NWL-1)
      IWEND=WEND*10.+.5
      WEND=FLOAT(IWEND)/10.
      IF(WNEW1.EQ.0.)WNEW1=WBEGIN
      IF(WNEW2.EQ.0.)WNEW2=WEND
  207 CONTINUE
      IF(IFLABL.GT.0.AND.NOCALC.EQ.0)THEN
      DO 2207 I=1,NWL
 2207 READ(7)
      READ(7)NLINES
      WRITE(93)NLINES
      DO 2208 I=1,NLINES
      READ(7)LINDAT8,LINDAT
 2208 WRITE(93)LINDAT8,LINDAT
      ENDIF
      CALL MAXLENGTH(500)
      CALL INITPLT(70)
C      CALL START AT (1.,.5)
C      CALL START AT (0.,OFFSET)
	if(ifdlin.eq.0)call weight(1)
	if(ifdlin.eq.1)call weight(2)
      END=0.
      NPANEL=(WNEW2-WNEW1+PANEL-.001)/PANEL
      IPAN1=0
      DO 100 IPANEL=1,NPANEL
      W1=WNEW1+FLOAT(IPANEL-1)*PANEL
      W2= MIN (W1+PANEL+.1,WNEW2)
C     W2=AMIN1(W1+PANEL+.1,WNEW2)
      WRITE(6,2990)IPANEL,W1,W2
 2990 FORMAT(6H PANEL,I3,2F10.3)
      IF(IFPANL(IPANEL).EQ.0)GO TO 100
      IF(IPAN1.GT.0)CALL PAGE
C      IF(IPAN1.GT.0)CALL START AT (10.,0.)
C      CALL START AT (4.85,.5+OFFSET)
c      CALL START AT (1.0+XOFFSET,.5+OFFSET)
      CALL START AT (1.0+XOFFSET,.5+OFFSET)
      IPAN1=1
      WW=W1
      ENCODE(6,2993,WW6)WW
 2993 FORMAT(F6.1)
      ENCODE(9,2991,HEADERDATA(1))USERID
      ENCODE(9,3992,HEADERDATA(2))JOBID
 3992 FORMAT(A4,A4)
      ENCODE(9,3992,HEADERDATA(3))ITIME
      ENCODE(9,3993,HEADERDATA(4))IDATE
 3993 FORMAT(A4,A4,A1)
      ENCODE(9,2991,HEADERDATA(5))FILENAME
 2991 FORMAT(A8,A1)
c     canon is 0.5 higher than xerox   THESE ARE CANON
      CANON=0.
      CANON=.5
c      IF(NOWAVE.EQ.0)THEN
c      CALL STRINGX10(WW6,0.,14.20-OFFSET+CANON)
c      CALL STRINGX10(WW6,19.5,14.20-OFFSET+CANON)
c      CALL STRINGX(HEADERDATA(1),4.0,14.85-OFFSET+CANON)
c      CALL STRINGX(HEADERDATA(2),4.0,14.70-OFFSET+CANON)
c      CALL STRINGX(HEADERDATA(3),4.0,14.55-OFFSET+CANON)
c      CALL STRINGX(HEADERDATA(4),4.0,14.40-OFFSET+CANON)
c      CALL STRINGX(HEADERDATA(5),4.0,14.25-OFFSET+CANON)
c      ENDIF
c      CALL STRINGX(MESSAGE(1),6.,14.85-OFFSET+CANON)
c      CALL STRINGX(MESSAGE(2),6.,14.70-OFFSET+CANON)
c      CALL STRINGX(MESSAGE(3),6.,14.55-OFFSET+CANON)
c      CALL STRINGX(MESSAGE(4),6.,14.40-OFFSET+CANON)
c      CALL STRINGX(MESSAGE(5),6.,14.25-OFFSET+CANON)
c      CALL STRINGX(MESSAGE(6),12.,14.70-OFFSET+CANON)
c      CALL STRINGX(MESSAGE(7),12.,14.55-OFFSET+CANON)
c      CALL STRINGX(MESSAGE(8),12.,14.40-OFFSET+CANON)
c      CALL STRINGX(MESSAGE(9),12.,14.25-OFFSET+CANON)
      CALL STRINGX(MESSAGE(1),3.,10.20)
      CALL STRINGX(MESSAGE(2),3.,9.95)
      CALL STRINGX(MESSAGE(3),3.,9.70)
      CALL STRINGX(MESSAGE(4),3.,9.45)
      CALL STRINGX(MESSAGE(5),3.,9.20)
      CALL STRINGX(MESSAGE(6),9.,9.95)
      CALL STRINGX(MESSAGE(7),9.,9.70)
      CALL STRINGX(MESSAGE(8),9.,9.45)
      CALL STRINGX(MESSAGE(9),9.,9.20)
      CALL COLOR BLACK
C
C     DRAW BOX
      END=(W2-W1)*10.*XSCALE
      CALL JUMP TO (0.,0.)
      CALL LINE TO (END,0.)
      YTOP=3.125*YSCALE
      CALL LINE TO (END,YTOP)
      CALL LINE TO (0.,YTOP)
      CALL LINE TO (0.,0.)
C
C     X AXIS
      N=(W2-W1)*10.+1.5
      IF(TICKTOP.EQ.0.)TICKTOP=-.15
      IF(TICKBOT.EQ.0.)TICKBOT=.15
      DO 11 I=1,N
      HALF=1.
      IF(XSCALE.LT.1..AND.MOD(I,5).NE.1)HALF=.5
      IF(XSCALE.LT..05.AND.MOD(I,100).NE.1)HALF=.5
      IF(XSCALE.LT..01.AND.MOD(I,500).NE.1)HALF=.5
      IF(XSCALE.LT..05.AND.MOD(I,10).NE.1)GO TO 11
      IF(XSCALE.LT..01.AND.MOD(I,100).NE.1)GO TO 11
      X=FLOAT(I-1)*XSCALE
      CALL JUMP TO (X,0.)
      CALL LINE TO (X,TICKBOT*HALF)
      CALL JUMP TO (X,YTOP+TICKTOP*HALF)
      CALL LINE TO (X,YTOP)
      WAVE=W1+FLOAT(I-1)/10.
      IF(XSCALE.LT.1..AND.MOD(I,5).NE.1)GO TO 11
      IF(XSCALE.LT..2.AND.MOD(I,10).NE.1)GO TO 11
      IF(XSCALE.LT..05.AND.MOD(I,100).NE.1)GO TO 11
      IF(XSCALE.LT..01.AND.MOD(I,500).NE.1)GO TO 11
      IF(IFNOAX.NE.1.AND.XSCALE.GE..2)THEN
      WRITE(WW6,'(F6.1)')WAVE
      CALL STRINGX2(WW6,X-.4,-.3)
      ENDIF
      IF(IFNOAX.NE.1.AND.XSCALE.LT..2)THEN
      IWAVE=WAVE
      WRITE(WW6,'(I6)')IWAVE
      CALL STRINGX2(WW6,X-.6,-.3)
      ENDIF
      IF(IFGRID.EQ.0)GO TO 11
      CALL JUMP TO (X,0.)
      CALL WEIGHT(12)
      CALL LINE TO (X,YTOP)
      CALL WEIGHT(1)            
   11 CONTINUE
C
      IF(XSCALE.GT.10..AND.IFNOAX.NE.1)THEN
      N=END*.1+.05
      DO 1611 I=1,N
      WAVE=W1+FLOAT(I)/XSCALE
      X=I*10
      WRITE(STRING9,'(F9.4)')WAVE
 1611 CALL STRINGX2(STRING9,X-.4,-.3) 
      ENDIF
C
C     Y AXIS
	if(rmin.eq.0.)then
      DO 12 I=1,11
      Y=FLOAT(I-1)*YTOP/10.
      CALL JUMP TO (0.,Y)
      CALL LINE TO (.15,Y)
      CALL JUMP TO (END-.15,Y)
      CALL LINE TO (END,Y)
   12 CONTINUE
	endif
      IF(IFLOG.EQ.1)GO TO 14
      ITWO=1
      IF(YTOP.LT.1.99)ITWO=2
      IF(IFNOAX.EQ.-1)THEN
C      DO 613 I=1,10,ITWO
C      Y=FLOAT(I-1)*YTOP/10.
C      R=(RMAX-RMIN)/10.*FLOAT(I-1)+RMIN
C      CALL WEIGHT(12)
C      ENCODE(6,2994,STRING6)R
C 2994 FORMAT(F2.1)
C      CALL STRINGX2(STRING6,-.23,Y)
CC      CALL BCDX(1,R,2,6H(F2.1),.15,-.23,Y)
C      CALL WEIGHT(1)
C      ENCODE(6,2995,STRING6)R
C 2995 FORMAT(F3.2)
C  613 CALL STRINGX2(STRING6,-.6,Y)
CC  613 CALL BCDX(1,R/10.+.9,3,6H(F3.2),.15,-.6,Y)
C      CALL WEIGHT(12)
C      ENCODE(6,1313,STRING6)RMAX
C      CALL STRINGX2(STRING6,-.9,Y-.05)
C      CALL WEIGHT(1)
      CALL WEIGHT(12)
      CALL STRINGX2('  1@ @ .@ @ @ @ 00',-.88,YTOP*1.)
      CALL STRINGX2('    .@ @ @ @ 9',-.88,YTOP*.9)
      CALL STRINGX2('    .@ @ @ @ 8',-.88,YTOP*.8)
      CALL STRINGX2('    .@ @ @ @ 7',-.88,YTOP*.7)
      CALL STRINGX2('    .@ @ @ @ 6',-.88,YTOP*.6)
      CALL STRINGX2('    .@ @ @ @ 5',-.88,YTOP*.5)
      CALL STRINGX2('    .@ @ @ @ 4',-.88,YTOP*.4)
      CALL STRINGX2('    .@ @ @ @ 3',-.88,YTOP*.3)
      CALL STRINGX2('    .@ @ @ @ 2',-.88,YTOP*.2)
      CALL STRINGX2('    .@ @ @ @ 1',-.88,YTOP*.1)
      CALL STRINGX2('    .@ @ @ @ 0',-.88,YTOP*.0)
      CALL WEIGHT(1)
      CALL STRINGX2(' .@ @ @ @ 99  ',-.88,YTOP*.9)
      CALL STRINGX2(' .@ @ @ @ 98  ',-.88,YTOP*.8)
      CALL STRINGX2(' .@ @ @ @ 97  ',-.88,YTOP*.7)
      CALL STRINGX2(' .@ @ @ @ 96  ',-.88,YTOP*.6)
      CALL STRINGX2(' .@ @ @ @ 95  ',-.88,YTOP*.5)
      CALL STRINGX2(' .@ @ @ @ 94  ',-.88,YTOP*.4)
      CALL STRINGX2(' .@ @ @ @ 93  ',-.88,YTOP*.3)
      CALL STRINGX2(' .@ @ @ @ 92  ',-.88,YTOP*.2)
      CALL STRINGX2(' .@ @ @ @ 91  ',-.88,YTOP*.1)
      CALL STRINGX2(' .@ @ @ @ 90  ',-.88,YTOP*.0)
      GO TO 17
      ENDIF
      DO 13 I=1,10,ITWO
      Y=FLOAT(I-1)*YTOP/10.
      R=(RMAX-RMIN)/10.*FLOAT(I-1)+RMIN
      CALL WEIGHT(1)
      IF(IFNOAX.EQ.1)GO TO 13
C      IF(RMAX-RMIN.GE..5)ENCODE(6,1313,STRING6)R
C      IF(RMAX-RMIN.LT..5)ENCODE(6,1314,STRING6)R
      ENCODE(6,1313,STRING6)R
      IF(RMAX-RMIN.LT.1.)ENCODE(6,1314,STRING6)R
      IF(I.GT.1)Y=Y-.03
      IF(YSCALE.LE..5)CALL STRINGX(STRING6,-.5,Y)
      IF(YSCALE.GT..5)CALL STRINGX2(STRING6,-.9,Y)
c      IF(YSCALE.GT..5)CALL STRINGX(STRING6,-.9,Y)
   13 CONTINUE
      IF(IFNOAX.EQ.1)GO TO 17
      ENCODE(6,1313,STRING6)RMAX
C      IF(RMAX-RMIN.GE..5)ENCODE(6,1313,STRING6)RMAX
 1313 FORMAT(F6.1)
C      IF(RMAX-RMIN.LT..5)ENCODE(6,1314,STRING6)RMAX
      IF(RMAX-RMIN.LT.1.)ENCODE(6,1314,STRING6)RMAX
 1314 FORMAT(F6.2)
      IF(YSCALE.LE..5)CALL STRINGX(STRING6,-.5,YTOP-.08)
      IF(YSCALE.GT..5)CALL STRINGX2(STRING6,-.9,YTOP-.16)
c      IF(YSCALE.GT..5)CALL STRINGX(STRING6,-.9,YTOP-.16)
      GO TO 17
   14 IF(IFABSO.EQ.1)GO TO 17
      DO 15 I=1,11
      Y=FLOAT(I-1)*YTOP/10.
      R=ALOG10(RMAX)-CYCLES+FLOAT(I-1)*CYCLES/10.
      IF(IFNOAX.EQ.1)GO TO 15
      ENCODE(6,1314,STRING6)R
      CALL STRINGX2(STRING6,-0.9,Y)
   15 CONTINUE
   17 IF(IFGRID.EQ.0)GO TO 20
C
      IF(IFGRID.EQ.1)THEN
      IF(XSCALE.LT.1.)GO TO 20
C     PLOT GRID
      XGRID=.1
      IF(XSCALE.EQ.4.)XGRID=.08
      IF(XSCALE.EQ.8.)XGRID=.08
      NGRID=END/XGRID
      DO 18 I=1,NGRID
      X=FLOAT(I)*XGRID
      CALL JUMP TO (X,0.)
      CALL WEIGHT(1)
C      IF(MOD(I,10).EQ.0)CALL WEIGHT(12)
C      CALL LINE TO (X,YTOP)
      IF(MOD(I,10).EQ.0)CALL LINE TO (X,YTOP)
      IF(MOD(I,10).NE.0)CALL DOTLINE(X,0.,X,YTOP,'E0E0'X)
   18 CONTINUE
C      DO 1118 I=1,NGRID*2.5
C      X=NGRID/10.
C      X=FLOAT(I)/10./2.5
C      CALL JUMP TO (X,0.)
C      CALL WEIGHT(1)
C      CALL LINE TO (X,-.07)
C 1118 CONTINUE
      DO 19 I=1,49
      Y=FLOAT(I)*YTOP/50.
      CALL JUMP TO (0.,Y)
      CALL WEIGHT(1)
C      IF(MOD(I,5).EQ.0)CALL WEIGHT(12)
C      CALL LINE TO (END,Y)
      IF(MOD(I,5).EQ.0)CALL LINE TO (END,Y)
      IF(MOD(I,5).NE.0)CALL DOTLINE(0.,Y,END,Y,'E0E0'X)
   19 CONTINUE
      CALL WEIGHT(1)
      ENDIF
C
      IF(IFGRID.EQ.2)THEN
      N=(W2-W1)*10.*10.+.5
      DO 4019 I=1,N
      X=FLOAT(I)*XSCALE*.1
      CALL JUMP TO (X,0.15)
      CALL LINE TO (X,YTOP-.15)
 4019 CONTINUE
      DO 4020 I=1,10
      Y=FLOAT(I)*YTOP*.1
      CALL JUMP TO (0.,Y)
      CALL LINE TO (END,Y)
 4020 CONTINUE
      ENDIF
C
      IF(IFGRID.EQ.3)THEN
      DO 4030 I=1,50
      Y=FLOAT(I)*YTOP*.02
      CALL JUMP TO (0.,Y)
      CALL LINE TO (END,Y)
 4030 CONTINUE
      ENDIF
C
   20 IF(NOCALC.EQ.0)THEN
C      IF(IFLOG.EQ.0)CALL STRINGY2('LIN',END+.4,.2)
C      IF(IFLOG.EQ.1)CALL STRINGY2('LOG',END+.4,.2)
      IF(IFABSO.EQ.0)CALL STRINGY2('RESIDUAL',END+.4,0.2)
      IF(IFABSO.EQ.1)CALL STRINGY2('ABSOLUTE',END+.4,0.2)
      ENDIF
      IF(IFABSO.EQ.0)GO TO 27
C     FIND MAX AND MIN
      HMAX=0.
      HMIN=1.E30
      IF(NOCALC.EQ.1)GO TO 270
      REWIND 7
      READ(7)
      NSKIP= LOG(W1/WBEGIN)/ LOG(RATIO)-2.
C     NSKIP=ALOG(W1/WBEGIN)/ALOG(RATIO)-2.
      NSKIP=MAX0(NSKIP,0)
      IF(NSKIP.EQ.0)GO TO 221
      DO 220 I=1,NSKIP
  220 READ(7)
  221 N1=NSKIP+1
      WBEGDOP=WBEGIN*(1.D0+DOPCALC/299792.458D0)
      IF(IFOPAC.GT.0)THEN
      READ(7)
      DO 223 IWL=N1,NWL
      READ(7)(ASYNTH(J),J=1,IFOPAC)
      WAVE=WBEGDOP*RATIO**(IWL-1)
      IF(WAVE.LT.W1)GO TO 223
      IF(WAVE.GT.W2+.0001)GO TO 24
      HMAX=AMAX1(HMAX,ASYNTH(IFOPAC))
      HMIN=AMIN1(HMIN,ASYNTH(IFOPAC))
  223 CONTINUE
      GO TO 24
      ENDIF
C
      DO 23 IWL=N1,NWL
      READ(7)(Q2(I),I=1,NMU2)
      WAVE=WBEGDOP*RATIO**(IWL-1)
      IF(WAVE.LT.W1)GO TO 23
      IF(WAVE.GT.W2+.0001)GO TO 24
      FREQ=2.997925E17/WAVE
      HLAM=Q2(MU)*FREQ/WAVE
      IF(Q2(MU).GT.Q2(MUNMU))HLAM=Q2(MUNMU)*FREQ/WAVE
      HMAX=AMAX1(HMAX,HLAM)
      HMIN=AMIN1(HMIN,HLAM)
      IF(IFCONT.EQ.0)GO TO 23
      CONT=Q2(MUNMU)*FREQ/WAVE
      HMAX=AMAX1(HMAX,CONT)
      HMIN=AMIN1(HMIN,CONT)
   23 CONTINUE
C
   24 WRITE(6,25)HMIN,HMAX
   25 FORMAT(1P2E12.3)
      ENCODE(9,3535,STRING9)HMAX
      CALL STRINGY2(STRING9,END+.6,YTOP-1.2)
      ENCODE(9,3535,STRING9)HMIN
      CALL STRINGY2(STRING9,END+.6,YTOP-2.8)
  270 CONTINUE
      IF(TOP.GT.0.)HMAX=TOP
      IF(IFLOG.EQ.0)GO TO 30
      IF(HMAX.EQ.0.)GO TO 30
      HMAXL=ALOG10(HMAX)
      N=(HMAXL+CYCLES/10.-.001)/(CYCLES/10.)
      HMAXL=FLOAT(N)*CYCLES/10.
      IF(TOP.GT.0.)HMAXL=ALOG10(TOP)
      HMINL=HMAXL-CYCLES
      HMAX=10.**HMAXL
      DO 26 I=1,11
      Y=FLOAT(I-1)*YTOP/10.
      H=HMINL+FLOAT(I-1)*CYCLES/10.
      ENCODE(6,1314,STRING6)H
      CALL STRINGX2(STRING6,-0.9,Y)
   26 CONTINUE
      GO TO 30
   27 IF(IFLOG.EQ.0)GO TO 30
      RMAXL=ALOG10(RMAX)
      RMINL=RMAXL-CYCLES
C     PLOT OBSERVED SPECTRUM
C     READS FROM 55
   30 CALL OBSERV
C     READS FROM 56
      CALL OBSERV1
C     READS FROM 57
      CALL OBSERV2
C     READS FROM 60
      IF(IFKPNO.GT.0)CALL OBSKPNO(IFKPNO)
C     READS FROM 61
      IF(IFKPK.GT.0)CALL OBSKPK(IFKPK)
C     READS FROM 62
      IF(IFSACP.GT.0)CALL OBSSACP(IFSACP)
C     READS FROM 63
      IF(IFHAWA.GT.0)CALL OBSHAWA(IFHAWA)
C     READS FROM 64
      IF(IFNRL.GT.0)CALL OBSNRL(IFNRL)
C     READS FROM 65
      IF(IFPROC.GT.0)CALL OBSPROC(IFPROC)
C     READS FROM 66
      IF(IFSIR.GT.0)CALL OBSSIR(IFSIR)
C     READS FROM 67
      IF(IFARC.GT.0)CALL OBSARC(IFARC)
C     READS FROM 68
      IF(IFSUNF.GT.0)CALL OBSSUNF(IFSUNF)
C     READS FROM 69
      IF(IFSOIR.GT.0)CALL OBSSOIR(IFSOIR)
C     READS FROM 59
      IF(IFHALL.GT.0)CALL OBSHALL(IFHALL)
C     READS FROM 58
      IF(IFENGV.GT.0)CALL OBSENGV(IFENGV)
C     READS FROM 73
      IF(IFFTS.GT.0)CALL OBSFTS(IFFTS)
C     READS FROM 71 AND 72
C      IF(IFFTS2.GT.0)CALL OBSENGV(IFFTS2)
      IF(IFFTS2.GT.0)CALL OBSFTS2(IFFTS2)
C     READS FROM 74
      IF(IFJUNG.GT.0)CALL OBSJUNG(IFJUNG)
      IF(NOCALC.EQ.1)GO TO 50
      IF(IFCONT.EQ.3)GO TO 735
C     PLOT SPECTRUM
      REWIND 7
      READ(7)
      NSKIP= LOG(W1/WBEGIN)/ LOG(RATIO)-2.
C     NSKIP=ALOG(W1/WBEGIN)/ALOG(RATIO)-2.
      NSKIP=MAX0(NSKIP,0)
      IF(NSKIP.EQ.0)GO TO 231
      DO 230 I=1,NSKIP
  230 READ(7)
  231 N1=NSKIP+1
      ISTART=0
      CALL WEIGHT(1)
      IF(IFDLIN.EQ.1)CALL WEIGHT(2)
      WBEGDOP=WBEGIN*(1.D0+DOPCALC/299792.458D0)
C
      IF(IFOPAC.GT.0)THEN
      READ(7)
      DO 233 IWL=N1,NWL
      READ(7)(ASYNTH(J),J=1,IFOPAC)
      WAVE=WBEGDOP*RATIO**(IWL-1)
      IF(WAVE.LT.W1)GO TO 233
      IF(WAVE.GT.W2+.0001)GO TO 734
      FREQ=2.99792458E17/WAVE
      HLAM=MAX(ASYNTH(IFOPAC),1.E-30)
      CONT=HMAX
      IF(IFABSO.EQ.0.AND.IFLOG.EQ.0)Y=(HLAM/CONT-RMIN)/(RMAX-RMIN)*YTOP
      IF(IFABSO.EQ.1.AND.IFLOG.EQ.0)Y=HLAM/HMAX*YTOP
      IF(IFABSO.EQ.0.AND.IFLOG.EQ.1)Y=(ALOG10(HLAM/CONT)-RMINL)/CYCLES*
     1YTOP
      IF(IFABSO.EQ.1.AND.IFLOG.EQ.1)Y=(ALOG10(HLAM)-HMINL)/CYCLES*YTOP
      IF(Y.LT.0.)Y=0.
      IF(Y.GT.YTOP)Y=YTOP
      X=(WAVE-W1)*10.*XSCALE
      IF(ISTART.EQ.0)CALL JUMP TO (X,Y)
      ISTART=1
      CALL LINE TO (X,Y)
  233 CONTINUE
      CALL WEIGHT(1)
      NSKIP=0
      GO TO 735
      ENDIF
C
      XOLD=0.
      YOLD=0.
      DO 33 IWL=N1,NWL
      READ(7)(Q2(I),I=1,NMU2)
      WAVE=WBEGDOP*RATIO**(IWL-1)
      IF(WAVE.LT.W1)GO TO 33
      IF(WAVE.GT.W2+.0001)GO TO 34
      FREQ=2.997925E17/WAVE
      HLAM=Q2(MU)*FREQ/WAVE
      CONT=Q2(MUNMU)*FREQ/WAVE
C      KEEPS EMISSION BELOW CONTINUUM
C      IF(IFABSO.EQ.0.AND.HLAM.GT.CONT)HLAM=CONT
      IF(IFABSO.EQ.0.AND.IFLOG.EQ.0)Y=(HLAM/CONT-RMIN)/(RMAX-RMIN)*YTOP
      IF(IFABSO.EQ.1.AND.IFLOG.EQ.0)Y=HLAM/HMAX*YTOP
      IF(IFABSO.EQ.0.AND.IFLOG.EQ.1)Y=(ALOG10(HLAM/CONT)-RMINL)/CYCLES*
     1YTOP
      IF(IFABSO.EQ.1.AND.IFLOG.EQ.1)Y=(ALOG10(HLAM)-HMINL)/CYCLES*YTOP
      X=(WAVE-W1)*10.*XSCALE
      XNEW=X
      YNEW=Y
      IF(Y.LT.0.)YNEW=0.
      IF(Y.GT.YTOP)YNEW=YTOP
      IF(Y*YOLD.LT.0.)XNEW=XOLD+(X-XOLD)/(Y-YOLD)*(0.-YOLD)
      IF((Y-YTOP)*(YOLD-YTOP).LT.0.)XNEW=XOLD+(X-XOLD)/(Y-YOLD)*
     1(YTOP-YOLD)
      IF(ISTART.EQ.0)CALL JUMP TO (XNEW,YNEW)
      ISTART=1
      CALL LINE TO (XNEW,YNEW)
      XOLD=X
      YOLD=Y
   33 CONTINUE
      CALL WEIGHT(1)
      IF(IFRMAX2.EQ.0)GO TO 732
   34 IF(IFRMAX2.EQ.0)GO TO 735
C
      XOLD=0.
      YOLD=0.
      REWIND 7
      READ(7)
      IF(NSKIP.EQ.0)GO TO 731
      DO 730 I=1,NSKIP
  730 READ(7)
  731 N1=NSKIP+1
      ISTART=0
      DO 733 IWL=N1,NWL
      READ(7)(Q2(I),I=1,NMU2)
      WAVE=WBEGDOP*RATIO**(IWL-1)
      IF(WAVE.LT.W1)GO TO 733
      IF(WAVE.GT.W2+.0001)GO TO 734
      FREQ=2.997925E17/WAVE
      HLAM=Q2(MU)*FREQ/WAVE
      CONT=Q2(MUNMU)*FREQ/WAVE
      IF(IFABSO.EQ.0.AND.HLAM.GT.CONT)HLAM=CONT
      IF(IFABSO.EQ.0.AND.IFLOG.EQ.0)Y=(HLAM/CONT-RMIN2)/(RMAX2-RMIN2)*
     1YTOP
      IF(IFABSO.EQ.1.AND.IFLOG.EQ.0)Y=HLAM/HMAX*YTOP
      IF(IFABSO.EQ.0.AND.IFLOG.EQ.1)Y=(ALOG10(HLAM/CONT)-RMINL)/CYCLES*
     1YTOP
      IF(IFABSO.EQ.1.AND.IFLOG.EQ.1)Y=(ALOG10(HLAM)-HMINL)/CYCLES*YTOP
      X=(WAVE-W1)*10.*XSCALE
      XNEW=X
      YNEW=Y
      IF(Y.LT.0.)YNEW=0.
      IF(Y.GT.YTOP)YNEW=YTOP
      IF(Y*YOLD.LT.0.)XNEW=XOLD+(X-XOLD)/(Y-YOLD)*(0.-YOLD)
      IF((Y-YTOP)*(YOLD-YTOP).LT.0.)XNEW=XOLD+(X-XOLD)/(Y-YOLD)*
     1(YTOP-YOLD)
      IF(ISTART.EQ.0)CALL JUMP TO (XNEW,YNEW)
      ISTART=1
      CALL LINE TO (XNEW,YNEW)
      XOLD=X
      YOLD=Y
  733 CONTINUE
  732 CALL WEIGHT(1)
      NSKIP=0
      GO TO 735
  734 NSKIP=NWL-IWL
      CALL WEIGHT(1)
  735 CONTINUE
C   35 IF(IFABSO.EQ.0)CALL BCDX(1,CONT,9,8H(1PE9.3),.15,END+.5,YTOP-.05)
C      IF(IFABSO.EQ.0)CALL BCDY(1,CONT,9,8H(1PE9.3),.15,-.05,YTOP+.25)
C      IF(IFABSO.EQ.1)CALL BCDX(1,HMAX,9,8H(1PE9.3),.15,END+.5,YTOP-.05)
C      IF(IFABSO.EQ.1)CALL BCDY(1,HMAX,9,8H(1PE9.3),.15,-.05,YTOP+.25)
      IF(IFABSO.EQ.0)ENCODE(9,3535,STRING9)CONT
      IF(IFABSO.EQ.1)ENCODE(9,3535,STRING9)HMAX
 3535 FORMAT(1PE9.3)
      CALL STRINGY2(STRING9,END+.4,YTOP-1.2)
      CALL STRINGY2(STRING9,-.15,YTOP+.25)
      IF(IFABSO.EQ.0)GO TO 50
      IF(IFCONT.EQ.0)GO TO 50
      IF(IFOPAC.GT.0)GO TO 50
C     PLOT CONTINUUM
      REWIND 7
      READ(7)
      NSKIP= LOG(W1/WBEGIN)/ LOG(RATIO)-2.
C     NSKIP=ALOG(W1/WBEGIN)/ALOG(RATIO)-2.
      NSKIP=MAX0(NSKIP,0)
      IF(NSKIP.EQ.0)GO TO 37
      DO 36 I=1,NSKIP
   36 READ(7)
   37 N1=NSKIP+1
      ISTART=0
      CALL WEIGHT(1)
      IF(IFDLIN.EQ.1)CALL WEIGHT(2)
      WBEGDOP=WBEGIN*(1.D0+DOPCALC/299792.458D0)
      XOLD=X
      YOLD=Y
      DO 43 IWL=N1,NWL
      READ(7)(Q2(I),I=1,NMU2)
      WAVE=WBEGDOP*RATIO**(IWL-1)
      IF(WAVE.LT.W1)GO TO 43
      IF(WAVE.GT.W2+.0001)GO TO 44
      FREQ=2.997925E17/WAVE
      CONT=Q2(MUNMU)*FREQ/WAVE
      IF(IFLOG.EQ.0)Y=CONT/HMAX*YTOP
      IF(IFLOG.EQ.1)Y=(ALOG10(CONT)-HMINL)/CYCLES*YTOP
      X=(WAVE-W1)*10.*XSCALE
      XNEW=X
      YNEW=Y
      IF(Y.LT.0.)YNEW=0.
      IF(Y.GT.YTOP)YNEW=YTOP
      IF(Y*YOLD.LT.0.)XNEW=XOLD+(X-XOLD)/(Y-YOLD)*(0.-YOLD)
      IF((Y-YTOP)*(YOLD-YTOP).LT.0.)XNEW=XOLD+(X-XOLD)/(Y-YOLD)*
     1(YTOP-YOLD)
      IF(ISTART.EQ.0)CALL JUMP TO (XNEW,YNEW)
      ISTART=1
      CALL LINE TO (XNEW,YNEW)
      XOLD=X
      YOLD=Y
   43 CONTINUE
      CALL WEIGHT(1)
      NSKIP=0
      GO TO 50
   44 NSKIP=NWL-IWL
      CALL WEIGHT(1)
   50 IF(IFLABL.EQ.0)GO TO 100
      IF(NOCALC.EQ.1)GO TO 336
      PRINT 1111,NWL,NSKIP
 1111 FORMAT(2I10)
C      IF(NSKIP.EQ.0)GO TO 336
C      DO 335 I=1,NSKIP
C  335 READ(7)
  336 CONTINUE
      REWIND 93
      ILABL=MOD(IFLABL,10)
      IF(ILABL.EQ.1)CALL LABEL1
      IF(ILABL.EQ.2)CALL LABEL2
      IF(ILABL.EQ.3)CALL LABEL3
      IF(ILABL.EQ.4)CALL LABEL4
      IF(ILABL.EQ.5)CALL LABEL5
      IF(ILABL.EQ.6)CALL LABEL6
      IF(ILABL.EQ.7)CALL LABEL7(IFOPAC)
      IF(ILABL.EQ.8)CALL LABEL8
      IF(ILABL.EQ.9)CALL LABEL9
  100 CONTINUE
      CALL FIN(70)
C      CALL ENDTIME
      CALL EXIT
      END
      SUBROUTINE OBSERV
C     PLOTS OBSERVED DATA IN X,Y FORM
C     IFSUNF=1 WEIGHT=2
C     IFSUNF=2 WEIGHT=1
C     IFSUNF=3 PLOT TWICE NORMAL WITH WEIGHT=2 AND 10 TIMES YSCALE WITH WEIGHT=1
C     IFSUNF=4 PLOT TWICE NORMAL WITH WEIGHT=1 AND 10 TIMES YSCALE WITH WEIGHT=1
      COMMON /PARAMS/XSCALE,
     1               RMIN,WEAK,TOP,PANEL,CYCLES,WBEGIN,WEND,W1,W2,YTOP,
     2               HMAX,HMIN,YSCALE,OFFSET,RMAX,
     3               WNEW1,WNEW2,SMOOTH,DOPOBS,DOPCALC,DOPTERR,
     4               SCALOBS,ZEROOBS,RMIN2,RMAX2,XOFFSET,SCALOB2,IUERM,
     5               IFLABL,IFABSO,IFCONT,IFGRID,IFDLIN,IFLOG,IFMU,NOCALC
     6               IFVAC,NOPRNT
      COMMON/COLOR/COLOROBS
      CHARACTER*10 COLOROBS
      REAL*8 WBEGIN,WEND,W1,W2,RESOLU,RATIO,WNEW1,WNEW2,WAVEL
      REAL*8 WI,W,WCUT,WRM,DOPOBS8
	REAL*4 WRM4(100)
      DIMENSION WCUT(7)
	dimension ss(460000)
	equivalence (si(1),ss(10001))
	dimension wtsmoo(10000)
	DIMENSION WRM(100)
CCRAY COMMON /WISI/WI(100000),SI(100000)
      COMMON /WISI/WI(450000),SI(450000)
C     COMMON MUST BE REMOVED TO PLOT TWO SPECTRA AT THE SAME TIME
      DATA WCUT/329.897,378.2914,401.965,473.8,576.5,753.9,999.7/
      DATA IREAD/0/
	DOPOBS8=DOPOBS
	IFSUNF=0
      IF(IREAD.EQ.1)GO TO 9
      IREAD=1
      OPEN(UNIT=55,SHARED,READONLY,TYPE='OLD',FORM='UNFORMATTED')
      NIN=0
      DO 4 I=1,1137795
C     W IS THE SOLAR AIR WAVELENGTH INCLUDING THE GRAVITATIONAL REDSHIFT
C     S IS THE PSEUDO-RESIDUAL FLUX
      READ(55,END=5)W,S
C     REMOVE GRAVITATIONAL RED SHIFT
c      W=W*(1.D0-0.636D0/299792.458D0)
      W=W*(1.D0+DOPOBS8/299792.458D0)
c	w=w+dopobs
      IF(W.LT.WNEW1)GO TO 4
      IF(W.GT.WNEW2)GO TO 5
      NIN=NIN+1
CCRAY IF(NIN.GT.100000)CALL ABORT
      IF(NIN.GT.450000)CALL ABORT
      WI(NIN)=W
      SI(NIN)=S
    4 CONTINUE
    5 CONTINUE
	IF(IUERM.EQ.0)GO TO 9
	OPEN(UNIT=56,SHARED,TYPE='OLD')
	READ(56,6)NORD
6	FORMAT(I5)
C	TYPE*,NORD
	DO 44 I=1,100
	READ(56,66,END=97)XRM,YRM,ZRM
66	FORMAT(1X,F10.4,1X,F15.4,1X,F10.4)
C	TYPE*,XRM,YRM,ZRM
	WRM(I)=(XRM*0.1)*(1.D0+DOPOBS8/299792.458D0)
	WRM(I)=(WRM(I)-W1)*XSCALE*10.
C	TYPE*, I,WRM(I)
44	CONTINUE
97	NPTI=I-1
    9 IF(NIN.EQ.0)RETURN
	if (smooth.gt.0) then
	nwt=3.*smooth
	nwt2=nwt*2+1
	sumwt=1.
	do 333 i=1,nwt
	wtsmoo(i)=exp(-(2.*float(i)/smooth*sqrt(alog(2.)))**2)
333	sumwt=sumwt+wtsmoo(i)*2.
	wtsmoo(nwt+1)=1./sumwt
	do 334 i=1,nwt
334	wtsmoo(nwt+1+i)=wtsmoo(i)/sumwt
	do 335 i=1,nwt
335	wtsmoo(i)=wtsmoo(nwt2+1-i)
	do 3330 i=1,nwt2
3330	print 3333, i,wtsmoo(i)
3333	format(i10,f10.7)
	do 337 i=1,nin
	i1=max0(i-nwt,1)
	i2=min0(i+nwt,nin)
	ss(i)=0.
	inwt1=i-nwt-1
	do 336 ii=i1,i2
336	ss(i)=ss(i)+wtsmoo(ii-inwt1)*si(ii)
337	continue
	do 338 i=1,nin
	nini=nin+1-i
338	si(nini)=ss(nini)
	endif
      CALL WEIGHT(2)
	if (ifsunf.eq.0.and.ifdlin.eq.0) call weight(1)
      IF(IFSUNF.EQ.2.OR.IFSUNF.EQ.12)CALL WEIGHT(1)
      ISTART=0
      CALL COLOR BLACK
      IF(COLOROBS.EQ.'RED      ')CALL COLOR RED 
      IF(COLOROBS.EQ.'BLUE     ')CALL COLOR BLUE 
	IF(IFABSO.EQ.0)GO TO 144
C	FIND MAX AND MIN
	HMAX=0.
	HMIN=1.E30
	DO 145 I=1,NIN
	HMAX=AMAX1(HMAX,SI(I))
	HMIN=AMIN1(HMIN,SI(I))
145	CONTINUE	
	IF(TOP.GT.0.)HMAX=TOP
144   DO 14 I=1,NIN
      W=WI(I)
      IF(W.LT.W1)GO TO 14
      IF(W.GT.W2)GO TO 15
      X=(W-W1)*XSCALE*10.
	IF(IFABSO.EQ.1)SI(I)=SI(I)/HMAX
      Y=(SI(I)-RMIN)/(RMAX-RMIN)*3.125*YSCALE
      Y=AMAX1(Y,0.)
      IF(ISTART.EQ.0)CALL JUMP TO (X,Y)
      ISTART=1
      CALL LINE TO (X,Y)
C	TYPE*, IUERM
	IF(IUERM.EQ.0)GO TO 14
	DO 339 IRM=1,NPTI
	WRM4(IRM)=WRM(IRM)
C	TYPE*,WRM4(IRM),X
	IF(ABS(WRM4(IRM)-X).LE.0.001)CALL X AT(WRM4(IRM),Y)
339	CONTINUE
   14 CONTINUE
   15 CONTINUE
        if(ifdlin.eq.0)CALL WEIGHT(1)
	if(ifdlin.eq.1)call weight(2)
      IF(IFSUNF.LT.3)RETURN
      ISTART=0
      DO 24 I=1,NIN                                                      
      W=WI(I)
      IF(W.LT.W1)GO TO 24                                                 
      IF(W.GT.W2)GO TO 25                                                 
      X=(W-W1)*XSCALE*10.                                                 
      XNEW=X
      S=SI(I)
      Y=(S-.9)/(1.0-.9)*3.125*YSCALE
      YNEW=Y
      IF(ISTART.EQ.0)THEN
      IF(Y.LT.0.)Y=0.
      GO TO 240
      ENDIF
      IF(YNEW.GE.0..AND.YOLD.GE.0.)GO TO 240
      Y=0.
      IF(YNEW.LT.0..AND.YOLD.LT.0.)GO TO 240
      IF(YOLD.LE.0.)GO TO 239
      X=XOLD+(XNEW-XOLD)/(YNEW-YOLD)*(0.-YOLD)
      GO TO 240
  239 X=XOLD+(XNEW-XOLD)/(YNEW-YOLD)*YNEW
  240 IF(ISTART.EQ.0)CALL JUMP TO (X,Y)                                   
      ISTART=1                                                            
      XOLD=XNEW
      YOLD=YNEW
      CALL LINE TO (X,Y)                                                  
   24 CONTINUE                                                            
   25 CONTINUE
      RETURN
      END
      SUBROUTINE OBSERV1
      RETURN
      END
      SUBROUTINE OBSERV2
      RETURN
      END
      SUBROUTINE OBSKPNO(IFKPNO)
      RETURN
      END
      SUBROUTINE OBSJUNG(IFJUNG)
      RETURN
      END
      SUBROUTINE OBSKPK(IFKPK)
C     HARVARD ROCKET SPECTRA  KOHL,PARKINSON,KURUCZ
      RETURN
      END
      SUBROUTINE OBSSACP(IFSACP)
C     SAC PEAK SOLAR ATLAS BY BECKERS, BRIDGES, AND GILLIAM
      RETURN
      END
      SUBROUTINE OBSHAWA(IFHAWA)
C     HAWAII ROCKET SPECTRA  ALLEN, MCALLISTER, AND JEFFRIES                    
      RETURN                                                                    
      END                                                                       
      SUBROUTINE OBSNRL(IFNRL)
      RETURN
      END
      SUBROUTINE OBSPROC(IFPROC)
      RETURN                                                              
      END                                                                 
      SUBROUTINE OBSARC(IFARC)
      RETURN
      END
      SUBROUTINE OBSSUNF(IFSUNF)
C     PLOTS KURUCZ, FURENLID, BRAULT, AND TESTERMAN SOLAR FLUX ATLAS
      RETURN
      END
      SUBROUTINE OBSSOIR(IFSOIR)
C     PLOTS DELBOUILLE, ROLAND, BRAULT, AND TESTERMAN INFRARED SOLAR ATLAS
      RETURN
      END
      SUBROUTINE OBSHALL(IFHALL)
C     PLOTS HALL INFRARED SUNSPOT ATLAS
      RETURN
      END
      SUBROUTINE OBSENGV(IFENGV)
C     PLOTS ENGVOLD SUNSPOT ATLAS
      RETURN
      END
      SUBROUTINE OBSFTS(IFFTS)
C     PLOTS A SPECTRUM FROM THE FTS AT KITT PEAK
      RETURN
      END
      SUBROUTINE OBSFTS2(IFFTS2)
C     PLOTS THE RATIO OF TWO SPECTRA FROM THE FTS AT KITT PEAK
      RETURN
      END
	SUBROUTINE OBSSIR(IFSIR)
	RETURN
	END
      SUBROUTINE LABEL1
C     LABELS COMPUTED SPECTRUM
      RETURN
      END
      SUBROUTINE LABEL2
      RETURN
      END
      SUBROUTINE LABEL3
      RETURN
      END
      SUBROUTINE LABEL4
      RETURN
      END
      SUBROUTINE LABEL5
C     LABELS ATMOSPHERIC LINES FROM AFCRL LINE LIST
      RETURN
      END
      SUBROUTINE NAMEMOL(MOLNAME,MOLCODE)
C     IDENTIFIES ISOTOPE CODES FOR AFCRL LINE LIST
      RETURN      
      END      
      SUBROUTINE LABEL6      
      RETURN
      END
      SUBROUTINE LABEL7(IFOPAC)
      RETURN
      END
      SUBROUTINE LABEL8
      RETURN
      END
      SUBROUTINE LABEL9
C     PIERCE AND BRECKENRIDGE LINE LIST FOR SOLAR CENTRAL INTENSITY
      RETURN
      END