c**************************************************************************** c Version: 0.3 c Last changed: Mario Monteiro, 2005-11 c These set of subroutines uses the data from the following inputs: c OSC, FGONG c to write the SROX (ascii) output file. c**************************************************************************** subroutine osc_srox (afileout,xin,ndimin,xdatain,aheaderin) c implicit double precision (b-h,o-y) implicit integer (i-n) parameter (npt=5000,ncol=40,ndat=200) character afileout*80,aheaderin*80,aheaderout*80 dimension aheaderin(10),aheaderout(10) dimension ndimin(ndat),xin(ncol,npt),xdatain(ndat) dimension ndimout(ndat),xout(ncol,npt),xdataout(ndat) c common /datanum/c4pi,cl10 common /dataphy/cg,csig,cmu common /datasun/sm,sr,sl,sbol c c------- Translation of the OSC input into the SROX output: c ndimout(1)=ndimin(1) c icentre=1 if (xin(1,1).gt.xin(1,ndimin(1))) icentre=ndimin(1) c xdataout(1)=cg xdataout(2)=xdatain(2) xdataout(3)=xdatain(1) xdataout(4)=xdatain(10) xdataout(5)=xdatain(9)/xin(10,icentre) if (ndimin(4).eq.6) then xdataout(6)=xin(23,icentre) else if (ndimin(4).eq.10) then xdataout(6)=xin(23,icentre) else if (ndimin(4).eq.14) then xdataout(6)=xin(23,icentre)+xin(24,icentre) else write (*,*) 'ERROR OSC_SROX 1: Unavailable option for abundances' endif xdataout(7)=xdatain(5) xdataout(8)=xdatain(4) xdataout(9)=xdatain(3)/sl fac=c4pi*csig teff=exp(0.25d0*log(xdatain(3)/(fac*xdatain(2)**2))) xdataout(10)=teff xdataout(11)=xdatain(11) xdataout(12)=0.0d0 xdataout(13)=0.0d0 xdataout(14)=xdatain(6) xdataout(15)=0.0d0 c fac1=cg*xdatain(1) do 40 i=1,ndimout(1) ni=ndimout(1)-i+1 xout(1,i)=xin(1,ni)/xdatain(2) xout(3,i)=xin(4,ni) xout(4,i)=xin(5,ni) xout(5,i)=xin(10,ni) if (i.gt.1) then xout(2,i)=exp(xin(2,ni)) dlpdlr=-(fac1*xout(2,i)/xin(4,ni))*xin(5,ni)/xin(1,ni) xout(6,i)=xin(15,ni)/dlpdlr xout(7,i)=xout(2,i)-xout(2,i-1) else xout(2,i)=0.0d0 xout(6,i)=0.0d0 xout(7,i)=0.0d0 endif xout(8,i)=xin(7,ni) xout(9,i)=xin(3,ni) xout(10,i)=xin(11,ni) xout(11,i)=xin(22,ni) xout(12,i)=xin(6,ni) xout(13,i)=xin(13,ni) xout(14,i)=-xin(12,ni) xout(15,i)=xin(8,ni) xout(16,i)=xin(9,ni) if (ndimin(4).eq.6) then xout(17,i)=xin(23,ni) xout(18,i)=xin(24,ni) xout(19,i)=0.0d0 xout(20,i)=xin(25,ni) xout(21,i)=xin(26,ni) xout(22,i)=xin(27,ni) xout(23,i)=0.0d0 xout(24,i)=xin(28,ni) xout(25,i)=0.0d0 else if (ndimin(4).eq.10) then xout(17,i)=xin(23,ni) xout(18,i)=xin(24,ni) xout(19,i)=xin(25,ni) xout(20,i)=xin(26,ni) xout(21,i)=xin(27,ni) xout(22,i)=xin(28,ni) xout(23,i)=xin(29,ni) xout(24,i)=xin(30,ni) xout(25,i)=xin(31,ni) else if (ndimin(4).eq.14) then xout(17,i)=xin(23,ni)+xin(24,ni) xout(18,i)=xin(25,ni) xout(19,i)=xin(26,ni) xout(20,i)=xin(29,ni) xout(21,i)=xin(30,ni) xout(22,i)=xin(31,ni) xout(23,i)=xin(32,ni) xout(24,i)=xin(33,ni) xout(25,i)=xin(34,ni) else write (*,*) 'ERROR OSC_SROX 2: Unavailable conversion', * 'of abundances' endif 40 continue c call write_srox (afileout,xout,ndimout,xdataout) c return end c**************************************************************************** subroutine fgong_srox (afileout,xin,ndimin,xdatain,aheaderin) c implicit double precision (b-h,o-y) implicit integer (i-n) parameter (npt=5000,ncol=40,ndat=200) character afileout*80,aheaderin*80,aheaderout*80 dimension aheaderin(10),aheaderout(10) dimension ndimin(ndat),xin(ncol,npt),xdatain(ndat) dimension ndimout(ndat),xout(ncol,npt),xdataout(ndat) c common /datanum/c4pi,cl10 common /dataphy/cg,csig,cmu common /datasun/sm,sr,sl,sbol c c------- Translation of the FGONG input into the SROX output: c ndimout(1)=ndimin(1) c icentre=1 if (xin(1,1).gt.xin(1,ndimin(1))) icentre=ndimin(1) c xdataout(1)=cg xdataout(2)=xdatain(2) xdataout(3)=xdatain(1) xdataout(4)=xdatain(12) xdataout(5)=xdatain(11)/xin(10,icentre) xdataout(6)=xin(6,icentre) xdataout(7)=xdatain(5) xdataout(8)=xdatain(4) xdataout(9)=xdatain(3)/sl fac=c4pi*csig teff=exp(0.25d0*log(xdatain(3)/(fac*xdatain(2)**2))) xdataout(10)=teff xdataout(11)=xdatain(13) xdataout(12)=0.0d0 xdataout(13)=0.0d0 xdataout(14)=xdatain(6) xdataout(15)=0.0d0 c fac1=cg*xdatain(1) do 40 i=1,ndimout(1) xout(1,i)=xin(1,i)/xdatain(2) xout(3,i)=xin(4,i) xout(4,i)=xin(5,i) xout(5,i)=xin(10,i) if (i.ne.icentre) then xout(2,i)=exp(xin(2,i)) dlpdlr=-(fac1*xout(2,i)/xin(4,i))*xin(5,i)/xin(1,i) xout(6,i)=xin(15,i)/dlpdlr xout(7,i)=xout(2,i)-xout(2,i-1) else xout(2,i)=0.0d0 xout(6,i)=0.0d0 xout(7,i)=0.0d0 endif xout(8,i)=xin(7,i) xout(9,i)=xin(3,i) xout(10,i)=xin(11,i) xout(11,i)=0.0d0 xout(12,i)=0.0d0 xout(13,i)=xin(13,i) xout(14,i)=-xin(12,i) xout(15,i)=xin(8,i) xout(16,i)=xin(9,i) xout(17,i)=xin(6,i) xout(18,i)=xin(21,i) xout(19,i)=xin(30,i) xout(20,i)=xin(22,i) xout(21,i)=xin(23,i) xout(22,i)=xin(24,i) xout(23,i)=xin(33,i) xout(24,i)=xin(25,i) xout(25,i)=xin(34,i) 40 continue c call write_srox (afileout,xout,ndimout,xdataout) c return end c*************************************************************************** subroutine write_srox (afileout,xout,ndimout,xdataout) c implicit double precision (b-h,o-y) implicit integer (i-n) parameter (npt=5000,ncol=40,ndat=200) character afileout*80,aheaderout*80 dimension aheaderout(10) dimension ndimout(ndat),xout(ncol,npt),xdataout(ndat) c c------- Writing out the FGONG file: write (*,1000) ndimout(1),afileout 1000 format (' Writing SROX model with ',i4, * ' mesh points, in file: ',a20,/) c open (2,file=afileout,form='formatted',status='unknown') c write (2,1010) ndimout(1)-1,(xdataout(i),i=1,15) do 10 i=1,ndimout(1) write (2,1010) i-1,(xout(j,i),j=1,25) 10 continue 1010 format (i8,1p25e17.9) c close (2) c return end c**************************************************************************