*============================================================================== * subroutine to write 2dF catalogue format files. * subroutine catwrite(iunit) * * written by S.M. Croom, 27/2/01. * * 06/06/03 (SMC): reduce decimal places in magnitude and colours to 3. * *############################################################################### * # * LICENCE # * # * This program is free software; you can redistribute it and/or # * modify it under the terms of the GNU General Public License # * as published by the Free Software Foundation; either version 2 # * of the License, or (at your option) any later version. # * # * This program is distributed in the hope that it will be useful, # * but WITHOUT ANY WARRANTY; without even the implied warranty of # * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # * GNU General Public License for more details. # * # * You should have received a copy of the GNU General Public License # * along with this program; if not, write to the Free Software # * Foundation, Inc., 59 Temple Place - Suite 330, # * Boston, MA 02111-1307, USA. # * # *############################################################################### * implicit none integer iunit character decjchar*2,decchar*2 include '2dfcatformat.h' *------------------------------------------------------------------------------ * * need to put a zero before any single digits in the degrees dec entry: write(decjchar,'(i2)') dec1j if (decjchar(1:1).eq.' ') decjchar(1:1)='0' write(decchar,'(i2)') dec1 if (decchar(1:1).eq.' ') decchar(1:1)='0' * write catalogue entries: write(iunit,2000,err=9999) iauname,ra1j,ra2j,ra3j & ,dsigncharj,decjchar,dec2j,dec3j,catno,catname,sector,ra1,ra2 & ,ra3,dsignchar,decchar,dec2,dec3,ukstfld,apmx,apmy,rarad & ,decrad,b,ub,br,nobs,z1,zq1,id1,date1,fobs1,fibre1,sn1,z2,zq2 & ,id2,date2,fobs2,fibre2,sn2,zprev,radio,xray,dust,comments1 & ,comments2 2000 format(a16,1x,i2,1x,i2,1x,f5.2,1x,a1,a2,1x,i2,1x,f4.1,1x,i5,1x,a10 & ,1x,a25,1x,i2,1x,i2,1x,f5.2,1x,a1,a2,1x,i2,1x,f4.1,1x,i3,1x & ,f9.2,1x,f9.2,1x,f11.8,1x,f11.8,4x,f6.3,3x,f7.3,3x,f7.3,2x,i2 & ,1x,f6.4,1x,i2,1x,a10,1x,a8,1x,i4,1x,i3,1x,f7.2,1x,f6.4,1x,i2 & ,1x,a10,1x,a8,1x,i4,1x,i3,1x,f7.2,1x,f5.3,1x,f6.1,1x,f7.4 & ,f8.5,1x,a20,1x,a20) return 9999 stop 'catalogue write error' end *==============================================================================