program skydelt character*80 fnamein, fnameout write(*,*) 'enter input coo file: ' read(*,'(a80)') fnamein open(15, file=fnamein, status='old') write(*,*) 'enter output coo file: ' read(*,'(a80)') fnameout open(25, file=fnameout, status='new') write(*,*) open(11, file='skydelt.list', status='old') read(11,*) read(11,*) read(11,*) wsky write(*,*) 'sky line = ', wsky read(11,*) disp write(*,*) 'dispersion = ', disp, ' A/pix' read(11,*) read(11,*) ndel write(*,*) ndel, ' apertures to update' write(*,*) open(12, file='trace.out', status='old') read(12,*) read(12,*) iap = 0 ios = 0 do i = 1, ndel read(11,*) idel write(*,*) 'updating aperture ', idel do while (iap .lt. idel .and. ios .eq. 0) read(15,'(1x,i4,2x,f8.2,f10.2,f8.5,f8.5, $ f8.2,f6.0,2x,f5.2,2x,2f7.3)',iostat=ios) $ iap, x, y, zz, zerzer, rr, class, rmag, dy, grcolor read(12,*) xx, yfit, yy if (ios .eq. 0 .and. iap .lt. idel) then write(25,'(1x,i4,2x,f8.2,f10.2,f8.5,f8.5, $ f8.2,f6.0,2x,f5.2,2x,2f7.3)') $ iap, x, y, zz, zerzer, rr, class, rmag, dy, grcolor else if (iap .eq. idel) then if (nint(xx) .ne. idel) then write(*,*) 'error: mismatch: idel, xx, yfit, yy = ', $ idel, xx, yfit, yy stop end if deltaw = (yy-yfit) * disp write(*,*) 'xx, yfit, yy, deltaw = ', $ xx, yfit, yy, deltaw deltaz = deltaw / wsky if (zerzer .gt. 0.) then zerzernew = sqrt(zerzer*zerzer + deltaz*deltaz) else zerzernew = 0. end if write(*,'(1x,i4,2x,f8.2,f10.2,f8.5,f8.5, $ f8.2,f6.0,2x,f5.2,2x,2f7.3)') $ iap, x, y, zz, zerzer, rr, class, $ rmag, dy, grcolor write(*,*) 'zerzer, deltaz, zerzernew = ', $ zerzer, deltaz, zerzernew write(25,'(1x,i4,2x,f8.2,f10.2,f8.5,f8.5, $ f8.2,f6.0,2x,f5.2,2x,2f7.3)') $ iap, x, y, zz, zerzernew, rr, class, $ rmag, dy, grcolor write(*,'(1x,i4,2x,f8.2,f10.2,f8.5,f8.5, $ f8.2,f6.0,2x,f5.2,2x,2f7.3)') $ iap, x, y, zz, zerzernew, rr, class, $ rmag, dy, grcolor write(*,*) else write(*,*) 'error: idel, iap, ios = ', $ idel, iap, ios stop end if end do c (iap .lt. idel .and. ios .eq. 0) end do c (i = 1, ndel) close(11) close(12) read(15,'(1x,i4,2x,f8.2,f10.2,f8.5,f8.5, $ f8.2,f6.0,2x,f5.2,2x,2f7.3)',iostat=ios) $ iap, x, y, zz, zerzer, rr, class, rmag, dy, grcolor do while (ios .eq. 0) write(25,'(1x,i4,2x,f8.2,f10.2,f8.5,f8.5, $ f8.2,f6.0,2x,f5.2,2x,2f7.3)') $ iap, x, y, zz, zerzer, rr, class, rmag, dy, grcolor read(15,'(1x,i4,2x,f8.2,f10.2,f8.5,f8.5, $ f8.2,f6.0,2x,f5.2,2x,2f7.3)',iostat=ios) $ iap, x, y, zz, zerzer, rr, class, rmag, dy, grcolor end do close(15) close(25) call exit(0) end