C main program "simply" does all the plotting stuff. Subroutine C "readem" does the filling up of C the x and y arrays and specifies the kind of point being plotted. C nsep=2 uses 2 symbols C nsep=3 uses 3 symbols C nsep=4 reads the format of the original n346 file "h45out" C or containing only the goodstuff h45outgood common /MONGOPAR/ 1 x1,x2,y1,y2,gx1,gx2,gy1,gy2,lx1,lx2,ly1,ly2, 1 gx,gy,cx,cy, 1 expand,angle,ltype,lweight, 1 cheight,cwidth,cxdef,cydef,pxdef,pydef,coff, 1 termout,xyswapped,numdev, 1 pi,uservar,autodot dimension x(5000),y(5000),xs(5000),xp(5000),ys(5000),yp(5000), & xz(5000),yz(5000) character*1 yesno character*4 sep character*2 typ dimension masses(9) character*80 lmcmaedertrack,smcmaedertrack, & galmaedertrack,filein, & lmcisofiles(5),smcisofiles(5),galisofiles(5), & isofiles(5),maedertrack, & title1,title2 data lmcmaedertrack /'/home/massey/imf/tracks/mod008nowr.dat'/ data smcmaedertrack /'/home/massey/imf/tracks/mod001nowr.dat'/ data galmaedertrack /'/home/massey/imf/tracks/modnewnowr.dat'/ data masses/120,85,60,40,25,15,7,5,3/ data smcisofiles/'result0016.3','result0016.6','result0016.78', & 'result0016.9','result0017.0'/ data lmcisofiles/'result0086.3','result0086.6','result0086.78', & 'result0086.9','result0087.0'/ data galisofiles/'result0206.3','result0206.6','result0206.78', & 'result0206.9','result0207.0'/ data filein/'lmcfieldoutnew3'/ ifancy=1 nsep=7 field=0.0 limit=3 Cwrite(6,1331) 1331 format('Input file name:',$) Cread(5,1334) filein if(ifancy.eq.0) then title1=filein write(title2,3) field,limit 3 format('field=',f4.1,' limit=',i1) else write(6,1332) filein 1332 format('file=',a80) write(6,1333) 1333 format('Input title1:',$) 1334 format(a80) read(5,1334) title1 write(6,1335) 1335 format('Input title2:',$) read(5,1334) title2 end if ntracks=9 itype=1 C C ifield (in data file) = 3 simply means >1.5 from anything C = 2 means <1.5 from S1 C = 1 means <1.5 from A2 C = 0 means <1.5 from A1 C C If we want to be conservative, take 3. (limit=3, field=1.5) C If we want to be extremely conserv, take 3 but higher field. C If you want to be less conservative (including non-guarenteed C field stars, do the following: C *limit=3 field=3.0 will take only some 3's. C *limit=3 field=1.5 will take all 3's C *limit=2 field=1.5 will take all 3's C *limit=1 field=1.5 will take all 3's, 2's. C *limit=0 field=1.5 will take all 3's, 2's, and 1's. C *limit=0 field=0.8 will take 3's, 2's, 1's, and some 0's. C C C Excludes all stars closer to an OB association than field times C the size of the nearest association, where an association is C limit=0 certain LH association (A1) C limit=1 " or prob LH association (A2) C limit=2 " " or star cloud (S1) C limit=3 should exclude EVERYTHING c 1=terminal c -6 = Barry's NAU printer, we hope c -14 = lw5 C -22 = lw9 C -8 = lw2 C -30 = eps file, good for transfer! iprinter=-30 111 continue C Set things up for the plotting call mgoinit call mgosetup (itype) call mgoerase call mgosetexpand(1.) call mgosetlim(4.9,2.,3.4,-13.) call mgosetlweight(1) C Draw the box call mgobox(1,2) call mgoxlabel(50,'Log T\\\\deff\\e') call mgoylabel(50,'M\\\\dbol\\e') call mgorelocate(4.7, 0.) call mgolabel(80,title1) call mgorelocate(4.7,0.75) call mgolabel(80,title2) call mgosetltype(0) C igal=1 MW C igal=2 LMC C igal=3 SMC igal=1 if((filein(1:3).eq.'smc').or.(filein(1:3).eq.'h45').or. & (filein(1:3).eq.'NGC')) igal=3 if (filein(1:3).eq.'lmc') igal=2 maedertrack=galmaedertrack if(igal.eq.2) maedertrack=lmcmaedertrack if(igal.eq.3) maedertrack=smcmaedertrack do 1101 i=1,5 if(igal.eq.1) then isofiles(i)=galisofiles(i) else if (igal.eq.2) then isofiles(i)=lmcisofiles(i) else isofiles(i)=smcisofiles(i) end if 1101 continue C plot the Maeder tracks do 100 i=1,ntracks call maederget(masses(i),maedertrack,x,y,icount) call mgoconnect(x,y,icount) 100 continue if(igal.lt.3) then call mgorelocate(3.8,-11.5) call mgolabel(50,'120\\sM\\do\\e') call mgorelocate(3.8,-11.0) call mgolabel(50,'85\\sM\\do\\e') call mgorelocate(3.875,-10.4) call mgolabel(50,'60\\sM\\do\\e') call mgorelocate(3.76,-9.7) call mgolabel(50,'40\\sM\\do\\e') call mgorelocate(3.675,-8.85) call mgolabel(50,'25\\sM\\do\\e') call mgorelocate(3.625,-7.55) call mgolabel(50,'15\\sM\\do\\e') call mgorelocate(3.6,-4.5) call mgolabel(50,'7\\sM\\do\\e') call mgorelocate(3.62,-3.5) call mgolabel(50,'5\\sM\\do\\e') call mgorelocate(3.675,-1.2) call mgolabel(50,'3\\sM\\do\\e') else call mgorelocate(4.35,-11.3) call mgolabel(50,'120\\sM\\do\\e') call mgorelocate(3.80,-10.9) call mgolabel(50,'85\\sM\\do\\e') call mgorelocate(3.780,-10.35) call mgolabel(50,'60\\sM\\do\\e') call mgorelocate(3.75,-9.75) call mgolabel(50,'40\\sM\\do\\e') call mgorelocate(3.57,-8.75) call mgolabel(50,'25\\sM\\do\\e') call mgorelocate(3.555,-7.35) call mgolabel(50,'15\\sM\\do\\e') call mgorelocate(3.525,-4.5) call mgolabel(50,'7\\sM\\do\\e') call mgorelocate(3.6,-3.1) call mgolabel(50,'5\\sM\\do\\e') call mgorelocate(3.675,-0.75) call mgolabel(50,'3\\sM\\do\\e') end if if(nsep.gt.7) then call mgosetangle(-20.) call mgorelocate(4.0,-9.00) call mgolabel(4,'V=11') call mgorelocate(4.0,-6.00) call mgolabel(4,'V=14') else if(nsep.eq.7) then call mgosetangle(+10.) call mgorelocate(3.8,-8.60) call mgolabel(4,'V=11') call mgorelocate(3.8,-5.60) call mgolabel(4,'V=14') call mgorelocate(3.8,-4.60) call mgolabel(4,'V=15') end if call mgosetangle(0.) if(nsep.lt.7) then do 101 i=1,5 call isochrome(isofiles,i,x,y,icount) call mgosetltype(2) call mgoconnect(x,y,icount) 101 continue call mgosetltype(0) end if C C C Great---now, go get some data C Go get the data C C C nsep=1: use only one symbol and one type of data if(nsep.eq.1) then call readem1(filein,x,y,icount,symbol, & limit,field) call mgopoints(symbol,1,x,y,icount) else if (nsep.eq.2) then call readem2(filein,xs,ys,ics,syms,xp,yp,icp,symp, & limit,field) call mgopoints(syms,1,xs,ys,ics) call mgopoints(symp,1,xp,yp,icp) else if (nsep.eq.3) then call readem3(filein, & xs,ys,is,syms,xp,yp,ip,symp,xz,yz,iz,symz, & limit,field) call mgopoints(syms,1,xs,ys,is) call mgopoints(symp,1,xp,yp,ip) call mgopoints(symz,1,xz,yz,iz) else if (nsep.eq.4) then call readem4(filein, & xs,ys,is,syms,xp,yp,ip,symp) call mgopoints(syms,1,xs,ys,is) call mgopoints(symp,1,xp,yp,ip) else is=0 open(unit=1,file='bccurve',status='old') 70 read(1,*,end=73) xa,bc,v14,v13,v10 is=is+1 xs(is)=xa ys(is)=v14 yp(is)=v13 yz(is)=v10 go to 70 73 call mgosetltype(3) if(nsep.lt.8) call mgoconnect(xs,ys,is) call mgoconnect(xs,yp,is) call mgoconnect(xs,yz,is) call mgosetltype(0) if(nsep.lt.8) then call readem2(filein,xs,ys,ics,syms,xp,yp,icp,symp, & limit,field) call mgopoints(syms,1,xs,ys,ics) call mgopoints(symp,1,xp,yp,icp) end if end if if(itype.gt.0) then call mgotidle(itype) write(6,71) 71 format(1x,'Would you like a hard copy now? y=yes') read(5,72) yesno 72 format(a1) if(yesno.eq.'y') then itype=iprinter go to 111 end if else call mgoprntplot(nvec) end if stop end subroutine maederget(mass,maedertrack,x,y,icount) character*80 linein character*80 maedertrack dimension x(1),y(1) open(unit=1,file=maedertrack,status='old') 2 format(a80) C call mgotidle(1) Cwrite(6,*) mass read(1,2) linein read(1,2) linein read(1,2) linein read(1,2) linein 1 read(1,2) linein if(linein(1:10).eq.' ') go to 1 if(linein(1:2).ne.' ') go to 1 read(linein(1:8),3) amass 3 format(f8.2) Cwrite(6,*) amass if(amass.ne.mass) go to 1 C read in another blank line read(1,2) linein C begin reading data; stop when blank line icount=0 5 read(1,2) linein if(linein(1:10).eq.' ') go to 99 read(linein,6) alum,temp Cwrite(6,*) alum,temp 6 format(25x,2f6.3) icount=icount+1 x(icount)=temp y(icount)=4.75-2.5*alum go to 5 99 close(unit=1) return end subroutine readem1(filein,x,y,icount,symbol,limit,field) dimension x(1),y(1) character*2 who character*80 filein open(unit=1,file=filein,status='old') C separate the stars into the ones with spectra and the ones with C photom icount=0 symbol=20*10.+0. 1 read(1,2,end=99) q,steff,sambol,pteff,pambol,ifield,dist,who 2 format(18x,f6.2,28x,f6.3,f6.1,14x,f6.3,f6.1,10x,i3,f6.1,17x,a2) if((steff.ne.0.).and.(sambol.lt.0.).and. & ((steff.gt.4.40).or.(steff.lt.4.).or.(q.gt.-.4))) then Cif(who.ne.'us') go to 1 if((ifield.le.limit).and.(dist.le.field)) go to 1 else if((pteff.eq.0.).or.(pambol.ge.0.)) go to 1 icount=icount+1 x(icount)=pteff y(icount)=pambol end if go to 1 99 close(unit=1) return end subroutine readem4(filein, . xs,ys,ics,syms,xp,yp,icp,symp) dimension xs(1),ys(1),xp(1),yp(1) character*2 who character*5 cross character*10 name character*80 filein open(unit=1,file=filein,status='old') C separate the stars into the ones with spectra and the ones with C photom ics=0 icp=0 syms=20*10.+3. symp=20*10.+0. 1 read(1,2,end=99) teff,ambol,cross 2 format(38x,f5.3,1x,f6.2,15x,a5) steff=0. sambol=0. pteff=0. pambol=0. if(cross.ne.' ') then steff=teff sambol=ambol else pteff=teff pambol=ambol end if if((steff.ne.0.).and.(sambol.lt.0.) C one of the following two lines need to be commented out: & ) then C & .and.((steff.gt.4.40).or.(steff.lt.4.).or. (q.gt.-.4) C one of the following two lines need to be commented out. C & )) then C & .or.(pteff.gt.4.40))) then ics=ics+1 xs(ics)=steff ys(ics)=sambol else if((pteff.eq.0.).or.(pambol.ge.0.)) go to 1 Cif(q.gt.-.4) go to 1 icp=icp+1 xp(icp)=pteff yp(icp)=pambol end if go to 1 99 close(unit=1) return end subroutine readem3(filein, . xs,ys,ics,syms,xp,yp,icp,symp,xz,yz,icz,symz, . limit,field) dimension xs(1),ys(1),xp(1),yp(1),xz(1),yz(1) character*2 who character*5 cross character*10 name character*80 filein open(unit=1,file=filein,status='old') C separate the stars into the ones with spectra and the ones with C photom ics=0 icp=0 icz=0 syms=20*10.+3. symp=20*10.+0. symz=5*10.+1. 1 read(1,2,end=99) q,steff,sambol,pteff,pambol,ifield,dist,who, & name,cross if((ifield.le.limit).and.(dist.le.field)) go to 1 if(filein(1:5).eq.'smcin') then if(name(1:2).eq.'AV') cross=name(1:5) end if 2 format(18x,f6.2,28x,f6.3,f6.1,20x,f6.3,f6.1,10x,i3,f6.1,17x, & a2, & 1x,a10,25x,a5) if((steff.ne.0.).and.(sambol.lt.0.) C one of the following two lines need to be commented out: & ) then C & .and.((steff.gt.4.40).or.(steff.lt.4.).or. (q.gt.-.4) C one of the following two lines need to be commented out. C & )) then C & .or.(pteff.gt.4.40))) then if(cross.ne.' ') then icz=icz+1 xz(icz)=steff yz(icz)=sambol go to 1 end if ics=ics+1 xs(ics)=steff ys(ics)=sambol else if((pteff.eq.0.).or.(pambol.ge.0.)) go to 1 Cif(q.gt.-.4) go to 1 if(cross.ne.' ') then icz=icz+1 xz(icz)=pteff yz(icz)=pambol go to 1 end if icp=icp+1 xp(icp)=pteff yp(icp)=pambol end if go to 1 99 close(unit=1) return end subroutine readem2(filein, & xs,ys,icounts,symbols,xp,yp,icountp,symbolp, & limit,field) dimension xs(1),ys(1),xp(1),yp(1) character*2 who character*80 filein open(unit=1,file=filein,status='old') C separate the stars into the ones with spectra and the ones with C photom icounts=0 icountp=0 symbols=20*10.+3. symbolp=20*10.+0. 1 read(1,2,end=99) q,steff,sambol,pteff,pambol,ifield,dist,who write(2,*) q,steff,sambol,pteff,pambol,limit,ifield,dist,field 2 format(18x,f6.2,28x,f6.3,f6.1,20x,f6.3,f6.1,10x,i3,f6.1, & 17x,a2) if((ifield.le.limit).and.(dist.le.field)) go to 1 write(2,3) 3 format(1x,'Made it through!') if((steff.ne.0.).and.(sambol.lt.0.) C one of the following two lines need to be commented out: & ) then C & .and.((steff.gt.4.40).or.(steff.lt.4.).or. (q.gt.-.4) C one of the following two lines need to be commented out. C & )) then C & .or.(pteff.gt.4.40))) then icounts=icounts+1 xs(icounts)=steff ys(icounts)=sambol else if((pteff.eq.0.).or.(pambol.ge.0.)) go to 1 Cif(q.gt.-.4) go to 1 icountp=icountp+1 xp(icountp)=pteff yp(icountp)=pambol end if go to 1 99 close(unit=1) return end subroutine isochrome(isofiles,inum,x,y,icount) dimension x(1),y(1) character*80 isofiles(1) open(unit=1,file=isofiles(inum),status='old') icount=0 1 read(1,*,end=99) int,asit,teff,ambol icount=icount+1 x(icount)=teff y(icount)=ambol go to 1 99 return end