character*80 inline character*10 Uimage C C C write(6,1001) 1001 format('Input U image root name: ',$) read(5,1002) Uimage alast=lnblnk(Uimage) 1002 format(a10) open(unit=1,file=Uimage(1:alast)//'.als.2',status='old') open(unit=2,file=Uimage(1:alast)//'f.als.2',status='new') 1 read(1,1100,end=5) inline 1100 format(a80) if(inline(1:1).eq.'#') then if(inline(4:8).eq.'IMAGE') then do 1105 ijk=17,30 if(inline(ijk:ijk).eq.' ') then inline(ijk:ijk)='f' go to 1106 end if 1105 continue stop 'problem in name' end if 1106 continue write(2,1100) inline go to 1 end if read(inline,*) id,x,y xp=(x-512.)/1.0044 + 512. yp=(y-512.)/1.0044 + 512. C This is REALLY silly! if(xp.lt.1.) then C skip this star) read(1,1100) inline go to 1 else if(xp.lt.10.) then write(inline(10:19),50) xp else if(xp.lt.100.) then write(inline(10:19),51) xp else if(xp.lt.1000.) then write(inline(10:19),52) xp else write(inline(10:19),53) xp end if 50 format(f5.3,6x) 51 format(f6.3,5x) 52 format(f7.3,4x) 53 format(f8.3,3x) if(yp.lt.1.) then read(1,1100) inline go to 1 else if(yp.lt.10.) then write(inline(20:29),50) yp else if(yp.lt.100.) then write(inline(20:29),51) yp else if (yp.lt.1000.) then write(inline(20:29),52) yp else write(inline(20:29),53) yp end if write(2,1100) inline C this inline is garbage: read(1,1100) inline write(2,1100) inline go to 1 5 continue C Whew! ALL DONE WITH ALS file. Now, let's do it again with the mag file, C shall we? close(unit=1) close(unit=2) open(unit=1,file=Uimage(1:alast)//'.mag.3',status='old') open(unit=2,file=Uimage(1:alast)//'f.mag.3',status='new') 2001 read(1,1100,end=2005) inline if(inline(1:1).eq.'#') then write(2,1100) inline go to 2001 end if C OK, we're here which means we are on the first line of a star. We C are going to assume that there are exactly 5 lines per star (1 aperture) C C On line 1 change the name: do 2002 i=1,23 if(inline(i:i).eq.' ') then inline(i:i)='f' go to 2003 end if 2002 continue stop 'problem in image name of mag file' 2003 write(2,1100) inline C Now read in line number 2 read(1,1100) inline read(inline,*) x,y xp=(x-512.)/1.0044 + 512. yp=(y-512.)/1.0044 + 512. C This is REALLY silly! if(xp.lt.1.) then C skip this star) read(1,1100) inline read(1,1100) inline read(1,1100) inline go to 2001 else if(xp.lt.10.) then write(inline(4:14),50) xp else if(xp.lt.100.) then write(inline(4:14),51) xp else if(xp.lt.1000.) then write(inline(4:14),52) xp else write(inline(4:14),53) xp end if if(yp.lt.1.) then read(1,1100) inline go to 1 else if(yp.lt.10.) then write(inline(15:25),50) yp else if(yp.lt.100.) then write(inline(15:25),51) yp else if (yp.lt.1000.) then write(inline(15:25),52) yp else write(inline(15:25),53) yp end if write(2,1100) inline C WHEW!!!!! C Now get the sky line read(1,1100) inline write(2,1100) inline C Now get the itime line read(1,1100) inline write(2,1100) inline C Now get the photometry line read(1,1100) inline write(2,1100) inline go to 2001 2005 continue close(unit=1) close(unit=2) stop 'all done' end