117 lines
3.3 KiB
Fortran
117 lines
3.3 KiB
Fortran
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
|