diff options
Diffstat (limited to 'Binary.f')
| -rwxr-xr-x | Binary.f | 198 |
1 files changed, 198 insertions, 0 deletions
diff --git a/Binary.f b/Binary.f new file mode 100755 index 0000000..e7043b2 --- /dev/null +++ b/Binary.f @@ -0,0 +1,198 @@ + + subroutine binary +c****************************************************************************** +c This program synthesizes a section of a spectroscopic binary star +c spectrum, using one model atmosphere for the primary and one model +c for the secondary, and then compares it to an observed spectrum. +c****************************************************************************** + + implicit real*8 (a-h,o-z) + include 'Atmos.com' + include 'Factor.com' + include 'Mol.com' + include 'Linex.com' + include 'Pstuff.com' + include 'Equivs.com' + include 'Multistar.com' + integer ncall + + +c*****examine the parameter file + begin = 0 + ncall = 1 +1 call params + linprintopt = linprintalt + if (begin .eq. 0) then + if (numpecatom .gt. 0) then + do i=3,95 + binpec(syncount,i) = pec(i) + do j=1,numatomsyn + binpecabund(syncount,i,j) = pecabund(i,j) + enddo + enddo + endif + else + if (numpecatom .gt. 0) then + do i=3,95 + pec(i) = binpec(syncount,i) + do j=1,numatomsyn + pecabund(i,j) = binpecabund(syncount,i,j) + enddo + enddo + endif + endif + + +c*****open the files for: standard output, raw spectrum depths, smoothed +c spectra, and (if desired) IRAF-style smoothed spectra + istat = ivcleof(5,1) + nf1out = 20 + lscreen = 4 + array = 'STANDARD OUTPUT' + nchars = 15 + call infile ('output ',nf1out,'formatted ',0,nchars, + . f1out,lscreen) + nf2out = 21 + lscreen = lscreen + 2 + array = 'RAW SYNTHESIS OUTPUT' + nchars = 20 + call infile ('output ',nf2out,'formatted ',0,nchars, + . f2out,lscreen) + if (syncount .eq. 1) then + f7out = f2out + else + f8out = f2out + endif + if (iraf .ne. 0) then + nf4out = 23 + lscreen = lscreen + 2 + array = 'IRAF ("rtext") OUTPUT' + nchars = 24 + call infile ('output ',nf4out,'formatted ',0,nchars, + . f4out,lscreen) + endif + + +c*****open and read the model atmosphere file + nfmodel = 30 + lscreen = lscreen + 2 + array = 'THE MODEL ATMOSPHERE' + nchars = 20 + call infile ('input ',nfmodel,'formatted ',0,nchars, + . fmodel,lscreen) + call inmodel + + +c*****open the line list file and the strong line list file + nflines = 31 + lscreen = lscreen + 2 + array = 'THE LINE LIST' + nchars = 13 + call infile ('input ',nflines,'formatted ',0,nchars, + . flines,lscreen) + if (dostrong .gt. 0) then + nfslines = 32 + lscreen = lscreen + 2 + array = 'THE STRONG LINE LIST' + nchars = 20 + call infile ('input ',nfslines,'formatted ',0,nchars, + . fslines,lscreen) + endif + + +c*****do the syntheses + if (numpecatom .eq. 0 .or. numatomsyn .eq. 0) then + isorun = 1 + nlines = 0 + mode = 3 + call inlines (1) + call eqlib + call nearly (1) + call synspec + else + do n=1,numatomsyn + isynth = n + isorun = 1 + start = oldstart + sstop = oldstop + mode = 3 + call inlines (1) + call eqlib + call nearly (1) + call synspec + linprintopt = 0 + enddo + endif + if (syncount .eq. 1) then + fluxprimary = flux + else + fluxsecondary = flux + endif + + +c*****finish the syntheses + call finish (1) + istat = ivcleof(4,1) + if (control .ne. 'gridend') go to 1 + + +c*****combine the synthetic spectra for plotting + call binplotprep + + +c*****now plot the spectrum, maybe iterating abundances, and end the program + if (plotopt.eq.2 .and. specfileopt.gt.0) then + nfobs = 33 + lscreen = lscreen + 2 + array = 'THE OBSERVED SPECTRUM' + nchars = 21 + if (specfileopt.eq.1 .or. specfileopt.eq.3) then + call infile ('input ',nfobs,'unformatted',2880,nchars, + . fobs,lscreen) + else + call infile ('input ',nfobs,'formatted ',0,nchars, + . fobs,lscreen) + endif + endif + if (plotopt .ne. 0) then + control = 'binary ' + nf2out = nf9out + nf3out = nf10out + call pltspec (lscreen,ncall) + if (choice .eq. 'n') then + do syncount=1,2 + if (numpecatom .gt. 0) then + do i=3,95 + pec(i) = binpec(syncount,i) + do j=1,numatomsyn + pecabund(i,j) = binpecabund(syncount,i,j) + enddo + enddo + endif + call chabund + do i=3,95 + binpec(syncount,i) = pec(i) + do j=1,numatomsyn + binpecabund(syncount,i,j) = pecabund(i,j) + enddo + enddo + enddo + call finish (1) + linecount = 0 + oldcount = 0 + begin = begin + 1 + choice = '1' + ncall = 2 + go to 1 + endif + endif + + call finish (0) + + end + + + + + + |