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 < 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 >= 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 < 100) then if (iunits == 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 >= 2) write (nf1out,1005) . (chi(j,k),k=1,3), charge(j), amass(j), rdmass(j) elseif (iatom < 10000) then call sunder (atom1(j),i1,i2) if (i1 == 1) then l = i1 i1 = i2 i2 = l endif leftovr = idint(10000.*(atom1(j)-iatom)+0.1) if (i1 < 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 == 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 >= 2) . write (nf1out,1005) . d0(j), (chi(j,k),k=1,2), charge(j), amass(j), . rdmass(j) elseif (iatom < 1000000) then call sunder (atom1(j),i1,i2) xia = dble(i2) call sunder (xia,i2,i3) if (iatom == 10108) then molname = 'H_2O ' else molname = 'CO_2 ' endif if (iunits == 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 >= 2) . write (nf1out,1005) . d0(j), (chi(j,k),k=1,2), charge(j), amass(j), . rdmass(j) endif enddo if (start/=0.0 .or. sstop/=0.0) then if (iunits == 1) then write (nf1out,1011) oldstart,oldstop,oldstep,olddelta else write (nf1out,1012) start,sstop,step,delta endif if (rwlow /= 0.) write (nf1out,1013) rwlow, rwhigh, rwstep endif if (linprintopt >= 3) then write (nf1out,1014) do j=1,95 if (elem(j) /= 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 >= 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 < 100) then if (iunits == 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 ==0) then write (nf2out,3001) linitle,moditle ifresh = 1 endif if (cogatom == 0.) then iatom = iabatom else iatom = idint(cogatom) endif xab = dlog10(xabund(iatom)) + 12. ich = idint(charge(lim1obs) + 0.1) if (atom1(lim1obs) < 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 == 1) then l = ia ia = ib ib = l endif leftovr = idint(10000.*(atom1(lim1obs)-iatom)+0.1) if (ia < 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) /= 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) /= '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) /= 'stopinfo!') call prinfo (line) write (nf2out,3008) average, deviate, kount if (kount > 2 .and. deltaep > 1.5) then write (array,3009) xxm1, xxb1, xxr1 if (errmess(1:9) /= '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) /= 'stopinfo!') then line = line + 1 call prinfo (line) endif write (nf2out,*) 'No statistics done for E.P. trends' endif if (kount > 2 .and. deltarw > 0.5) then write (array,3010) xxm2, xxb2, xxr2 if (errmess(1:9) /= '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) /= 'stopinfo!') then line = line + 1 call prinfo (line) endif write (nf2out,*) 'No statistics done for R.W. trends' endif if (kount > 2 .and. deltawv > 500.) then write (array,3011) xxm3, xxb3, xxr3 if (errmess(1:9) /= '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) /= '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