! @(#)renawfpc.prg	17.1.1.1 (ES0-DMD) 01/25/02 17:15:01
! @(#)renawfpc.prg	17.1.1.1 01/25/02 17:15:01
!****************************************************************************
!Procedure renawfpc.prg
!Almudena Prieto December 1991
!
!  Renames WF/PC  files produced by OUTAPE/FITS to their original names
! stored in the FITS descriptor FILENAME.
! 
!****************************************************************************
!
! Read the WF/PC files produced by OUTAPE/FITS
DEFINE/PAR P1 ? C   "Give the inicial/s of your WF/PC files:"

creat/icat iwfpc {p1}*.bdf
creat/tcat twfpc {p1}*.tbl

!Renames bdf files
!
DEFINE/LOCAL CATAL/I/1/2 0,0
DEFINE/LOCAl II/I/1/1 0
WRITE/KEY NAME/C/1/20 " "
First_LOOP:
STORE/FRAME IN_B twfpc.cat 1 First

READ/KEY IN_B
STORE/FRAME IN_A iwfpc.cat 2 First
READ/KEY IN_A
II = M$INDEX(NAME,".")
COPY/DK 'IN_A' FILENAME NAME
II = M$INDEX(NAME,".")-1
RENAME/table 'IN_B' 'NAME(1:{II})'
GOTO First_LOOP
First:
dele/key CATAL

!Renames tbl files

DEFINE/LOCAL CATAL/I/1/1 0
CAT_LOOP:
STORE/FRAME IN_A iwfpc.cat 1 TABLES
II = M$INDEX(NAME,".")
COPY/DK 'IN_A' FILENAME NAME
II = M$INDEX(NAME,".")-1
RENAME/IMA 'IN_A' 'NAME(1:{II})'
GOTO CAT_LOOP
TABLES:

! clean up area
del/icat  iwfpc no
del/tcat twfpc no
del dirfile.dat nc
$rm iwfpc.cat
$rm twfpc.cat

!exit