SUBROUTINE OUTPRI
C
C     Output of synthetic spectrum
C
C     Output onto unit 7 serves as an input to the next program
C     ROTINS, which performs convolutions for the rotational and
C     instrumental broadening, and plots the synthetic spectrum
C
      INCLUDE 'PARAMS.FOR'
      INCLUDE 'MODELP.FOR'
      INCLUDE 'SYNTHP.FOR'
      PARAMETER (UN=1.,CAS=1./2.997925D18,EQWC=1.19917D22)
      PARAMETER (PI2=3.141592654/2.)
      DIMENSION FLX(3),REL(3),ALX(3)
      COMMON/EMFLUX/FLUX(MFREQ),FLUXC(MFREQC)
C
      if(ifwin.le.0) then
C
C     output of synthetic spectrum on unit 7
C
         DO IJ=3,NFREQ-1
            FLAM=FLUX(IJ)*FREQ(IJ)*FREQ(IJ)*CAS
            WRITE(7,701) WLAM(IJ),FLAM
         END DO
C
C        output of the continuum flux on unit 17
C
         FLAM=FLUX(1)*FREQ(1)*FREQ(1)*CAS
         WRITE(17,701) WLAM(1),FLAM
         IF(IBLANK.EQ.NBLANK) THEN
            FLAM=FLUX(NFREQ)*FREQ(NFREQ)*FREQ(NFREQ)*CAS
            WRITE(7,701) WLAM(NFREQ),FLAM
            FLAM=FLUX(2)*FREQ(2)*FREQ(2)*CAS
            WRITE(17,701) WLAM(2),FLAM
         END IF
       else
         DO IJ=1,NFROBS
            FLAM=FLUX(IJ)*FRQOBS(IJ)*FRQOBS(IJ)*CAS*0.5
            flam=max(flam,1.e-40)
            WRITE(7,701) WLobs(IJ),FLAM
         END DO
      end if
C
C     unit 6 and 16 outputs
C
      if(iprin.lt.3) return
      if(iprin.ge.3) then
      WRITE(6,600)
      WRITE(6,601)
      end if
      K1=0
      EQW=0.
      EQWP=0.
      IF(IBLANK.EQ.1) EQWT=0.
      IF(IBLANK.EQ.1) EQWTP=0.
      XX=UN/(FREQ(2)-FREQ(1))
      XXX=UN/(FREQ(1)+FREQ(2))/(FREQ(1)+FREQ(2))
      if(ifwin.le.0) then
      DO IJ=1,NFREQ
         FLAM=FLUX(IJ)*FREQ(IJ)*FREQ(IJ)*CAS
         CONT=((FREQ(IJ)-FREQ(1))*FLUX(2)+(FREQ(2)-FREQ(IJ))*FLUX(1))*XX
         RE0=FLUX(IJ)/CONT
         EQW=EQW+(UN-RE0)*W(IJ)
         REP=RE0
         IF(REP.GT.UN) REP=UN
         EQWP=EQWP+(UN-REP)*W(IJ)
         K1=K1+1
         FLX(K1)=LOG10(FLAM)
         ALX(K1)=WLAM(IJ)
         REL(K1)=RE0
         IF(K1.EQ.3.OR.IJ.EQ.NFREQ) THEN
            WRITE(6,602) (ALX(I),FLX(I),REL(I),I=1,K1)
            K1=0
         END IF
      END DO
      else
      DO IJ=1,NFROBS
         FLAM=FLUX(IJ)*FREQ(IJ)*FREQ(IJ)*CAS
         CONT=((FRQOBS(IJ)-FREQ(1))*FLUX(2)+
     *        (FREQ(2)-FRQOBS(IJ))*FLUX(1))*XX
         RE0=FLUX(IJ)/CONT
         EQW=EQW+(UN-RE0)*W(IJ)
         REP=RE0
         IF(REP.GT.UN) REP=UN
         EQWP=EQWP+(UN-REP)*W(IJ)
         if(iprin.gt.0) then
            K1=K1+1
            FLX(K1)=LOG10(FLAM)
            ALX(K1)=WLAM(IJ)
            REL(K1)=RE0
            IF(K1.EQ.3.OR.IJ.EQ.NFREQ) THEN
               WRITE(6,602) (ALX(I),FLX(I),REL(I),I=1,K1)
               K1=0
            END IF
         end if
      END DO
      end if
C
C     output of partial equivalent widths on unit 16
C
      EQW=EQW*EQWC*XXX
      EQWT=EQWT+EQW
      EQWP=EQWP*EQWC*XXX
      EQWTP=EQWTP+EQWP
      if(iprin.gt.2) WRITE(6,603) EQW,EQWP,EQWT,EQWTP
      WRITE(16,616) WLAM(1),WLAM(2),EQW,EQWP,EQWT,EQWTP
C
  600 FORMAT(/' EMERGENT RADIATION'/' ------------------'/)
  601 FORMAT(3('   LAMBDA  LOG HLAM    REL')/)
  602 FORMAT(3(2X,F9.3,F8.4,F7.3))
  603 FORMAT(/,'  EQUIVALENT WIDTH THIS SET  =',2F8.1,' mA'/
     *            '  EQUIVALENT WIDTH TOTAL     =',2F8.1,' mA'//)
  616 FORMAT(2F12.3,4F12.1)
  701 FORMAT(F12.5,1PE15.5)
      RETURN
      END