program axftoreg character*80 axffile, entry write(*,*) 'enter axf file name: ' read(*,'(a80)') axffile ccc axffile = 'temp.axf' open(11, file=axffile, status='old') js = index(axffile, ' ') - 1 write(*,*) 'writing to ', axffile(1:js)//'.reg' open(21, file=axffile(1:js)//'.reg', status='unknown') write(*,*) 'writing to ', axffile(1:js)//'.saoreg' open(31, file=axffile(1:js)//'.saoreg', status='unknown') write(*,*) 'x shift = ' cc read(*,*) xshift xshift = 0. write(*,*) 'skip 2 lines? (1=yes): ' read(*,*) iskip cc iskip = 1 if (iskip .eq. 1) then read(11,'(a80)') entry write(21,'(a80)') entry write(31,'(a80)') entry read(11,*) end if rad = 2. w2 = 6300. w1 = 4400. ws = 5176. disp = 5.2 read(11,*,iostat=ios) $ i, cenx, ceny, dright, dleft, ippp, rmag, $ ireals, dety, color do while (ios .eq. 0) cenx = cenx + xshift cc ceny = ceny + 1638.-1560. x1 = cenx - abs(dright) x2 = cenx + abs(dleft) x0 = (x1+x2) / 2. y0 = ceny - dety dx = abs(dright) + abs(dleft) dy = 5. p2 = y0 + (w2-ws)/disp p1 = y0 + (w1-ws)/disp p0 = (p1+p2)/2. + 1638.-1560. ccc p0 = (p1+p2)/2. + 1638.-1560. - 200. ccc fudge for Z5 mask dp = p2-p1 if (ireals .gt. 0) then write(21,'(a8,f7.2,a,f7.2,a,f4.1,a)') $ '-circle(', cenx, ',', ceny, ',', $ rad, ')' write(21,'(a5,4(f7.2,a),f4.1,a)') $ '+box(', x0, ',', y0, ',', $ dx, ',', dy, ',', rot, ')' write(21,'(a5,4(f7.2,a),f4.1,a)') $ '-box(', x0, ',', p0, ',', $ dx, ',', dp, ',', rot, ')' write(31,'(a8,f7.2,a,f7.2,a,f4.1,a)') $ '-CIRCLE(', cenx, ',', ceny, ',', $ rad, ')' write(31,'(a5,4(f7.2,a),f4.1,a)') $ ' BOX(', x0, ',', y0, ',', $ dx, ',', dy, ',', rot, ')' write(31,'(a5,4(f7.2,a),f4.1,a)') $ '-BOX(', x0, ',', p0, ',', $ dx, ',', dp, ',', rot, ')' write(31,'(a7,2(f7.2,a),a3,i4,a2)') $ '#-TEXT(', x0-dx/4., ',', ceny-20., ',', $ '4,"', ireals, '")' else write(21,'(a8,f7.2,a,f7.2,a,f4.1,a)') $ '+circle(', cenx, ',', ceny, ',', $ rad, ')' write(31,'(a8,f7.2,a,f7.2,a,f4.1,a)') $ ' CIRCLE(', cenx, ',', ceny, ',', $ rad, ')' write(31,'(a7,2(f7.2,a),a3,i4,a2)') $ '#-TEXT(', cenx, ',', ceny+20., ',', $ '4,"', ireals, '")' end if read(11,*,iostat=ios) $ i, cenx, ceny, dright, dleft, ippp, rmag, $ ireals, dety, color end do call exit(0) end