atools: asttran2 now writes the last position to output parameters

Starlink · Dec 3, 2013 · ebe3abf · ebe3abf
1 parent d728ec0
commit ebe3abf
Show file tree

Hide file tree

Showing 3 changed files with 40 additions and 4 deletions.
diff --git a/applications/atools/asttran2.f b/applications/atools/asttran2.f
@@ -62,14 +62,22 @@ SUBROUTINE ASTTRAN2( STATUS )
 *        The name of a text file in which to put the transformed X axis
 *        values. No file is produced if a null (!) value is supplied. One
 *        axis value is stored on each line of the file. [!]
+*     XVAL = _DOUBLE (Write)
+*        An output parameter that is left holding the final transformed
+*        output X value.
 *     YOUT = LITERAL (Read)
 *        The name of a text file in which to put the transformed Y axis
 *        values. No file is produced if a null (!) value is supplied. One
 *        axis value is stored on each line of the file. [!]
+*     YVAL = _DOUBLE (Write)
+*        An output parameter that is left holding the final transformed
+*        output Y value.
 
 *  Copyright:
 *     Copyright (C) 2003-2004 Central Laboratory of the Research
-*     Councils. All Rights Reserved.
+*     Councils.
+*     Copyright (C) 2013 Science & Technology Facilities Council.
+*     All Rights Reserved.
 
 *  Licence:
 *     This program is free software; you can redistribute it and/or
@@ -97,6 +105,8 @@ SUBROUTINE ASTTRAN2( STATUS )
 *        Original version.
 *     2004 September 1 (TIMJ):
 *        Use CNF_PVAL
+*     3-DEC-2013 (DSB):
+*        Added parameters XVAL and YVAL.
 *     {enter_further_changes_here}
 
 *  Bugs:
@@ -191,7 +201,7 @@ SUBROUTINE ASTTRAN2( STATUS )
 *  Output the results.
       CALL ATL1_PRNT2( NP, %VAL( CNF_PVAL( IPXOUT ) ),
      :                 %VAL( CNF_PVAL( IPYOUT ) ), 'XOUT',
-     :                 'YOUT', STATUS )
+     :                 'YOUT', 'XVAL', 'YVAL', STATUS )
 
 *  Free resources.
       CALL GRP_DELET( IGRP1, STATUS )

diff --git a/applications/atools/atl1_prnt2.f b/applications/atools/atl1_prnt2.f
@@ -1,4 +1,5 @@
-      SUBROUTINE ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, STATUS )
+      SUBROUTINE ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, XPAR2, YPAR2,
+     :                       STATUS )
 *+
 *  Name:
 *     ATL1_PRNT2
@@ -11,7 +12,7 @@ SUBROUTINE ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, STATUS )
 *     Starlink Fortran 77
 
 *  Invocation:
-*     CALL ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, STATUS )
+*     CALL ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, XPAR2, YPAR2, STATUS )
 
 *  Description:
 *     The screen output is one position per line, x followed y y
@@ -35,11 +36,16 @@ SUBROUTINE ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, STATUS )
 *        receive the Y values. If a null (!) value is obtained no output
 *        file is created and the error is annulled. If a blank value is
 *        supplied for YPAR no output file is created.
+*     XPAR2 = CHARACTER * ( * ) (Given)
+*        An output parameter name to which is written the final X value.
+*     YPAR2 = CHARACTER * ( * ) (Given)
+*        An output parameter name to which is written the final Y value.
 *     STATUS = INTEGER (Given and Returned)
 *        The global status.
 
 *  Copyright:
 *     Copyright (C) 2003 Central Laboratory of the Research Councils.
+*     Copyright (C) 2013 Science & Technology Facilities Council.
 *     All Rights Reserved.
 
 *  Licence:
@@ -65,6 +71,8 @@ SUBROUTINE ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, STATUS )
 *  History:
 *     6-JUN-2003 (DSB):
 *        Original version.
+*     3_DEC-2013 (DSB):
+*        Added arguments XPAR2 and YPAR2.
 *     {enter_further_changes_here}
 
 *  Bugs:
@@ -86,6 +94,8 @@ SUBROUTINE ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, STATUS )
       DOUBLE PRECISION YOUT( NP )
       CHARACTER XPAR*(*)
       CHARACTER YPAR*(*)
+      CHARACTER XPAR2*(*)
+      CHARACTER YPAR2*(*)
 
 *  Status:
       INTEGER STATUS             ! Global status
@@ -166,4 +176,8 @@ SUBROUTINE ATL1_PRNT2( NP, XOUT, YOUT, XPAR, YPAR, STATUS )
 
       END IF
 
+*  Write the last values to the output parameters.
+      IF( XPAR2 .NE. ' ' ) CALL PAR_PUT0D( XPAR2, XOUT( NP ), STATUS )
+      IF( YPAR2 .NE. ' ' ) CALL PAR_PUT0D( YPAR2, YOUT( NP ), STATUS )
+
       END
diff --git a/applications/atools/atools.ifd.in b/applications/atools/atools.ifd.in
@@ -3038,6 +3038,18 @@ iraf! {
             default !
             helpkey *
           }
+         parameter xval {
+            type _DOUBLE
+            access WRITE
+            vpath INTERNAL
+            helpkey *
+          }
+         parameter yval {
+            type _DOUBLE
+            access WRITE
+            vpath INTERNAL
+            helpkey *
+          }
       }
 
       action astswitchmap {