diff options
Diffstat (limited to 'Lineinfo.f')
| -rwxr-xr-x | Lineinfo.f | 356 |
1 files changed, 356 insertions, 0 deletions
diff --git a/Lineinfo.f b/Lineinfo.f new file mode 100755 index 0000000..bf5a420 --- /dev/null +++ b/Lineinfo.f @@ -0,0 +1,356 @@ + + subroutine lineinfo (number) +c****************************************************************************** +c This routine is an output subroutine for things having to do with +c lines. +c number = 1 gives input line data information +c****************************************************************************** + + implicit real*8 (a-h,o-z) + include 'Atmos.com' + include 'Linex.com' + include 'Mol.com' + include 'Dummy.com' + include 'Factor.com' + include 'Pstuff.com' + include 'Quants.com' + real*8 loggf, logstrength + integer ifresh + character*8 molname + character*4 ion(3) + character*1 name*1 + data ifresh /0/ + data ion/' I ', ' II ', ' III'/ + + + go to (1,2,3), number + + +c*****here the line data are output to "standard_out"; all relevant +c drivers use this +c if you don't want any line output, linprintopt=0 will exit the routine + +1 if (linprintopt .lt. 1) return + +c if you want standard output, linprintopt=1 is chosen +c linprintopt>=2 outputs ionization potentials, charges, masses, +c reduced masses for molecules, +c linprintopt>=3 outputs partition functions +c lineprintop =4 outputs line-center opacities + write (nf1out,1001) nlines + if (linprintopt .ge. 2) write (nf1out,1002) + do j=1,nlines + ich = idint(charge(j) + 0.1) + iatom = idint(atom1(j)) + loggf = dlog10(gf(j)) + logstrength = dlog10(strength(j)) + if (iatom .lt. 100) then + if (iunits .eq. 1) then + write (nf1out,1003) j, 1.d-4*wave1(j), names(iatom), + . ion(ich), atom1(j), e(j,1), loggf, damptype(j), + . logstrength, 1000.*width(j) + else + write (nf1out,1004) j, wave1(j), names(iatom), + . ion(ich), atom1(j), e(j,1), loggf, damptype(j), + . logstrength, 1000.*width(j) + endif + if (linprintopt .ge. 2) write (nf1out,1005) + . (chi(j,k),k=1,3), charge(j), amass(j), rdmass(j) + elseif (iatom .lt. 10000) then + call sunder (atom1(j),i1,i2) + if (i1 .eq. 1) then + l = i1 + i1 = i2 + i2 = l + endif + leftovr = idint(10000.*(atom1(j)-iatom)+0.1) + if (i1 .lt. 10) then + read (names(i1),1006) name + write (molname,1007) name,names(i2),leftovr + else + write (molname,1008) names(i1),names(i2),leftovr + endif + if (iunits .eq. 1) then + write (nf1out,1009) j, 1.d-4*wave1(j), molname, + . atom1(j), e(j,1), loggf, damptype(j), + . logstrength, 1000.*width(j) + else + write (nf1out,1010) j, wave1(j), molname, + . atom1(j), e(j,1), loggf, damptype(j), + . logstrength, 1000.*width(j) + endif + if (linprintopt .ge. 2) + . write (nf1out,1005) + . d0(j), (chi(j,k),k=1,2), charge(j), amass(j), + . rdmass(j) + elseif (iatom .lt. 1000000) then + call sunder (atom1(j),i1,i2) + xia = dble(i2) + call sunder (xia,i2,i3) + if (iatom .eq. 10108) then + molname = 'H_2O ' + else + molname = 'CO_2 ' + endif + if (iunits .eq. 1) then + write (nf1out,1009) j, 1.d-4*wave1(j), molname, + . atom1(j), e(j,1), loggf, damptype(j), + . logstrength, 1000.*width(j) + else + write (nf1out,1010) j, wave1(j), molname, + . atom1(j), e(j,1), loggf, damptype(j), + . logstrength, 1000.*width(j) + endif + if (linprintopt .ge. 2) + . write (nf1out,1005) + . d0(j), (chi(j,k),k=1,2), charge(j), amass(j), + . rdmass(j) + endif + enddo + if (start.ne.0.0 .or. sstop.ne.0.0) then + if (iunits .eq. 1) then + write (nf1out,1011) oldstart,oldstop,oldstep,olddelta + else + write (nf1out,1012) start,sstop,step,delta + endif + if (rwlow .ne. 0.) write (nf1out,1013) rwlow, rwhigh, rwstep + endif + if (linprintopt .ge. 3) then + write (nf1out,1014) + do j=1,95 + if (elem(j) .ne. 0.) then + iatom = int(elem(j)) + write (nf1out,1015) iatom, names(iatom), xam(j), + . xchi1(j), xchi2(j), xchi3(j) + do k=1,4 + write (nf1out,1016) k-1,(u(j,k,i),i=1,ntau) + enddo + endif + enddo + endif + if (linprintopt .ge. 4) then + write (nf1out,1001) + do j=1,nlines + write (nf1out,1002) j,(kapnu0(j,i),i=1,ntau) + enddo + endif + return + + +c*****here the STRONG line data are output; MOOG assumes that no +c molecular line can possibly be in this category +2 write (nf1out,2001) nstrong + do j=nlines+1,nlines+nstrong + ich = idint(charge(j) + 0.1) + iatom = idint(atom1(j)) + loggf = dlog10(gf(j)) + logstrength = dlog10(strength(j)) + if (iatom .lt. 100) then + if (iunits .eq. 1) then + write (nf1out,1003) j-nlines,1.d-4*wave1(j),names(iatom), + . ion(ich), atom1(j), e(j,1), loggf, + . damptype(j), logstrength + else + write (nf1out,1004) j-nlines, wave1(j),names(iatom), + . ion(ich), atom1(j), e(j,1), loggf, + . damptype(j), logstrength + endif + else + write (*,2004) iatom + stop + endif + enddo + printstrong = 1 + return + + +c*****results of force-fitting EW to yield abundances are output here +c look here also for the calls to the trend line calculations +3 if (ifresh .eq.0) then + write (nf2out,3001) linitle,moditle + ifresh = 1 + endif + if (cogatom .eq. 0.) then + iatom = iabatom + else + iatom = idint(cogatom) + endif + xab = dlog10(xabund(iatom)) + 12. + ich = idint(charge(lim1obs) + 0.1) + if (atom1(lim1obs) .lt. 100.) then + write (array,3002) names(iatom), ion(ich) ,xab + line = 1 + call prinfo (line) + write (nf2out,*) + write (nf2out,3002) names(iatom), ion(ich), xab + write (array,3003) + line = 2 + call prinfo (line) + write (nf2out,3003) + else + call sunder (atom1(lim1obs),ia,ib) + if (ia .eq. 1) then + l = ia + ia = ib + ib = l + endif + leftovr = idint(10000.*(atom1(lim1obs)-iatom)+0.1) + if (ia .lt. 10) then + read (names(ia),1006) name + write (molname,1007) name,names(ib) + else + write (molname,1008) names(ia),names(ib) + endif + write (array,3004) molname,xab + line = 1 + call prinfo (line) + write (nf2out,*) + write (nf2out,3004) molname,xab + write (array,3005) names(iabatom) + line = 2 + call prinfo (line) + write (nf2out,3005) names(iabatom) + write (array,3006) + line = 3 + call prinfo (line) + write (nf2out,3006) + endif + do l=lim1obs,lim2obs + if (abundout(l) .ne. 999.99) then + diff = abundout(l) - average + else + diff = 999.99 + endif + ew = 1000.*width(l) + rw = dlog10(width(l)/wave1(l)) + loggf = dlog10(gf(l)) + write (array,3007) wave1(l), atom1(l), e(l,1), loggf, + . ew, rw, abundout(l), diff + if (errmess(1:9) .ne. 'stopinfo!') then + line = line + 1 + call prinfo (line) + endif + write (nf2out,3007) wave1(l), atom1(l), e(l,1), loggf, + . ew, rw, abundout(l), diff + enddo + write (array,3008) average, deviate, kount + line = line + 1 + if (errmess(1:9) .ne. 'stopinfo!') call prinfo (line) + write (nf2out,3008) average, deviate, kount + if (kount .gt. 2 .and. deltaep .gt. 1.5) then + write (array,3009) xxm1, xxb1, xxr1 + if (errmess(1:9) .ne. 'stopinfo!') then + line = line + 1 + call prinfo (line) + endif + write (nf2out,3009) xxm1, xxb1, xxr1 + else + write (array,*) 'No statistics done for E.P. trends' + if (errmess(1:9) .ne. 'stopinfo!') then + line = line + 1 + call prinfo (line) + endif + write (nf2out,*) 'No statistics done for E.P. trends' + endif + if (kount .gt. 2 .and. deltarw .gt. 0.5) then + write (array,3010) xxm2, xxb2, xxr2 + if (errmess(1:9) .ne. 'stopinfo!') then + line = line + 1 + call prinfo (line) + endif + write (nf2out,3010) xxm2, xxb2, xxr2 + else + write (array,*) 'No statistics done for R.W. trends' + if (errmess(1:9) .ne. 'stopinfo!') then + line = line + 1 + call prinfo (line) + endif + write (nf2out,*) 'No statistics done for R.W. trends' + endif + if (kount .gt. 2 .and. deltawv .gt. 500.) then + write (array,3011) xxm3, xxb3, xxr3 + if (errmess(1:9) .ne. 'stopinfo!') then + line = line + 1 + call prinfo (line) + endif + write (nf2out,3011) xxm3, xxb3, xxr3 + else + write (array,*) 'No statistics done for wavelength trends' + if (errmess(1:9) .ne. 'stopinfo!') then + line = line + 1 + call prinfo (line) + endif + write (nf2out,*) 'No statistics done for wavelength trends' + endif + return + + +c*****format statements +1001 format (/'INPUT LINES DATA FOR ' ,i5, ' LINES'/ + . ' #', 5x, 'wave1', 3x, 'spec', 9x, 'spec#', + . 3x, 'E.P.', 3x, 'loggf', 5x, 'damp', 4x, 'logSTR', + . 5x, 'E.W.') +1002 format (20x, 6x, 'chi1', 4x, 'chi2', 6x, 'chi3', 4x, 'charge', + . 6x, 'mass', 4x, 'rdmass') +1003 format (i4, f10.6, 2x, a2, a4, f13.5, f7.3, f8.3, 2x, a7, + . f9.1, f9.2) +1004 format (i4, f10.3, 2x, a2, a4, f13.5, f7.3, f8.3, 2x, a7, + . f10.2, f8.2) +1005 format (20x, f10.3, f8.3, f10.3, f10.1, f10.2, f10.4) +1006 format (a1) +1007 format (1x,a1,a2,i4) +1008 format (2a2,i4) +1009 format (i4, f10.6, 3x, a4, 1x, f13.5, f7.3, f8.3, 2x, a7, + . f10.2, f8.2) +1010 format (i4, f10.3, 3x, a4, 1x, f13.5, f7.3, f8.3, 2x, a7, + . f10.2, f8.2) +1011 format (/'SYNTHETIC SPECTRUM PARAMETERS (units=1/cm)'/ + . 10x,'start =',f11.3,' ',5x,'stop =',f11.3,' '/ + . 'step size in the spectrum =',f11.4,' '/ + . 'at each point, opacity will include lines' , + . ' within',f11.4,' of the point') +1012 format (/'SYNTHETIC SPECTRUM PARAMETERS (units=A)'/ + . 10x,'start =',f11.3,' ',5x,'stop =',f11.3,' '/ + . 'step size in the spectrum =',f11.3,' '/ + . 'at each point, opacity will include lines' , + . ' within',f11.3,' of the point') +1013 format (/'CURVE-OF-GROWTH PARAMETERS'/ + . 10x,'log(R.W) lower bound =',f7.3, + . 10x,'upper bound =',f7.3/ + . 10x,'step size in the curve =',f7.3) +1014 format (/'PARTITION FUNCTIONS') +1015 format (/'Z =',i2,' (',a2,'), mass=',f8.3,' I.P.s=', 3f7.3) +1016 format (' ionization state = ',i1/(10f8.3)) +2001 format (/'INPUT LINES DATA FOR',i4,' STRONG LINES'/ + . ' #', 5x, 'wave1', 3x, 'spec', 9x, 'spec#', + . 3x, 'E.P.', 3x, 'loggf', 5x, 'damp', 4x, 'logSTR') +2004 format ('SPECIES = ', i5, ' IS A MOLECULE, NOT ALLOWED AS A ', + . 'STRONG LINE; I QUIT!') +3001 format (a80) +3002 format ('Abundance Results for Species ',a2,a4, + . ' (input abundance = ',f7.3,')') +3003 format ('wavelength', 9x, 'ID', 6x, 'EP', 3x, 'logGF', 5x, 'EWin', + . 3x, 'logRWin', 5x, 'abund', 3x, 'delavg') +3004 format ('Abundance Results for Species ',a8, + . ' (input abundance = ',f6.2,')') +3005 format ('From these data, the abundance of ',a2, + . ' will be altered') +3006 format ('wavelength', 9x, 'ID', 6x, 'EP', 3x, 'logGF', 5x, 'EWin', + . 3x, 'logRWin', 5x, 'abund', 3x, 'delavg') +3007 format (f10.3, f11.5, f8.3, f8.3, f9.2, f10.3, f10.3, f9.3) +3008 format ('average abundance = ',f6.3,' std. ', + . 'deviation = ',f6.3,' #lines = ',i3) +3009 format ('E.P. correlation: slope = ',f7.3,' intercept = ', + . f7.3,' corr. coeff. = ',f7.3) +3010 format ('R.W. correlation: slope = ',f7.3,' intercept = ', + . f7.3,' corr. coeff. = ',f7.3) +3011 format ('wav. correl.: slope = ',1pd11.3,' intercept = ', + . 0pf7.3,' corr. coeff. = ',f7.3) + + + + return + end + + + |