Skip to content

Commit

Permalink
kappa: Allow ndfecho to create names by modification of a base group
Browse files Browse the repository at this point in the history 
This also allows you to report names of NDFs that do not exist.
  • Loading branch information
David Berry committed Oct 11, 2012
1 parent 0b368ea commit 56828d7
Show file tree
Hide file tree
Showing 3 changed files with 201 additions and 61 deletions.
19 changes: 15 additions & 4 deletions applications/kappa/kappa.ifd.in
View file
Expand Up @@ -1154,7 +1154,7 @@ package kappa {
helplib {$KAPPA_HELP}

parameter first {
position 2
position 3
type _INTEGER
vpath DEFAULT
ppath CURRENT DEFAULT
Expand All @@ -1164,26 +1164,37 @@ package kappa {
}

parameter last {
position 3
position 4
type _INTEGER
vpath DYNAMIC
ppath DYNAMIC
prompt {Index of last NDF to display}
helpkey *
}

parameter mod {
position 2
type LITERAL
access READ
ppath CURRENT,DEFAULT
vpath DEFAULT
default !
prompt {The NDFs to be listed}
helpkey *
}

parameter ndf {
position 1
type NDF
access READ
ppath GLOBAL
association <-GLOBAL.DATA_ARRAY
prompt {The input NDFs}
prompt {A group of existing NDFs}
helpkey *
}

parameter show {
position 4
position 5
type LITERAL
vpath DEFAULT
ppath CURRENT DEFAULT
Expand Down
185 changes: 133 additions & 52 deletions applications/kappa/libndfpack/ndfecho.f
View file
Expand Up @@ -24,9 +24,19 @@ SUBROUTINE NDFECHO( STATUS )
* screen. Its primary use is within scripts that need to process
* groups of NDFs. Instead of the full name, a required component of
* the name may be displayed instead (see Parameter SHOW).
*
* Two modes are available:
*
* - If the NDFs are specified via the "NDF" parameter, then the NDFs
* must exist and be accessible (an error is reported otherwise). The
* NDF names obtained can then be modified by supplying a suitable GRP
* modification expression such as "*_A" for parameter "MOD"
*
* - To list NDFs that may not exist, supply a null (!) value for
* parameter "NDF" and the main group expression to parameter "MOD".

* Usage:
* ndfecho ndf [first] [last] [show]
* ndfecho ndf [mod] [first] [last] [show]

* ADAM Parameters:
* FIRST = _INTEGER (Read)
Expand All @@ -40,10 +50,21 @@ SUBROUTINE NDFECHO( STATUS )
* only a single NDF will be displayed). If a null value is
* supplied for FIRST, then the run-time default for LAST is the
* last NDF in the supplied group. []
* MOD = LITERAL (Read)
* An optional GRP modification expression that will be used to
* modify any names obtained via the "NDF" parameter. For instance,
* if "MOD" is "*_A" then the supplied NDF names will be modified
* by appending "_A" to them. No modification occurs if a null (!)
* value is supplied.
*
* If a null value is supplied for "NDF" then the value supplied
* for "MOD" should not include an asterisk, since there are no
* names to be modified. Instead, the "MOD" value should specify an
* explicit group of NDF names that do not need to exist. [!]
* NDF = NDF (Read)
* A group of NDFs. This should be given as a comma-separated
* list, in which each list element can be one of the following
* options.
* A group of existing NDFs, or null (!). This should be given as
* a comma-separated list, in which each list element can be one
* of the following options:
*
* - An NDF name, optionally containing wild-cards and/or regular
* expressions ("*", "?", "[a-z]" etc.).
Expand All @@ -60,6 +81,9 @@ SUBROUTINE NDFECHO( STATUS )
* then you are re-prompted for further input until a value is
* given which does not end with a hyphen. All the NDFs given in
* this way are concatenated into a single group.
*
* If a null (!) value is supplied, then the displayed list of NDFs
* is determined by the value supplied for the "MOD" parameter.
* SHOW = LITERAL (Read)
* Specifies the information to be displayed about each NDF. The
* options are as follows.
Expand Down Expand Up @@ -92,10 +116,19 @@ SUBROUTINE NDFECHO( STATUS )
* Examples:
* ndfecho mycont
* Report the full path of all the NDFs within the HDS container
* file "mycont.sdf".
* file "mycont.sdf". The NDFs must all exist.
* ndfecho ^files.lis first=4 show=base
* This reports the file base name for just the fourth NDF in the
* list specified within the text file "files.lis".
* list specified within the text file "files.lis". The NDFs must
* all exist.
* ndfecho ^files.lis *_a
* This reports the names of the NDFs listed in text file files.lis,
* but appending "_a" to the end of each name. The NDFs must all exist.
* ndfecho in=! mod={^base}|_a|_b|
* This reports the names of the NDFs listed in text file "base", but
* replacing "_a" with "_b" in their names. The NDFs need not exist
* since they are completely specified by parameter "MOD" and not by
* parameter "NDF".

* Copyright:
* Copyright (C) 2012 Science & Technology Facilities Council.
Expand Down Expand Up @@ -124,6 +157,8 @@ SUBROUTINE NDFECHO( STATUS )
* History:
* 24-SEP-2012 (DSB):
* Original version.
* 11-OCT-2012 (DSB):
* Added parameter MOD.
* {enter_further_changes_here}

*-
Expand All @@ -147,90 +182,136 @@ SUBROUTINE NDFECHO( STATUS )
CHARACTER SHOW*7 ! What to show
INTEGER FIRST ! The index of the first NDF to display
INTEGER I ! Index of next NDF to display
INTEGER IGRP ! GRP id. for group holding input NDFs
INTEGER IGRP0 ! GRP id. for group holding existing NDFs
INTEGER IGRP1 ! GRP id. for group holding listed NDFs
INTEGER ILEN ! Length of the NDF info item
INTEGER ISHOW ! What to show
INTEGER LAST ! The index of the last NDF to display
INTEGER SIZE ! Total size of the input group

INTEGER SIZE0 ! Size of group IGRP0
INTEGER SIZE1 ! Size of group IGRP1
LOGICAL FLAG ! Was group expression flagged?
*.

* Check the inherited status.
IF ( STATUS .NE. SAI__OK ) RETURN

* Get a group containing the names of the NDFs to be processed.
CALL KPG1_RGNDF( 'NDF', 0, 1, ' Give more NDFs...',
: IGRP, SIZE, STATUS )

* See what the user wants to display.
CALL PAR_CHOIC( 'SHOW', 'PATH', 'SLICE,HDSPATH,FTYPE,BASE,DIR,'//
: 'PATH', .TRUE., SHOW, STATUS )
IF( SHOW .EQ. 'SLICE' ) THEN
ISHOW = 1
ELSE IF( SHOW .EQ. 'HDSPATH' ) THEN
ISHOW = 2
ELSE IF( SHOW .EQ. 'FTYPE' ) THEN
ISHOW = 3
ELSE IF( SHOW .EQ. 'BASE' ) THEN
ISHOW = 4
ELSE IF( SHOW .EQ. 'DIR' ) THEN
ISHOW = 5
ELSE
ISHOW = 6
* Get a group containing the names of any existing NDFs to be listed.
* Allow this group to contain zero NDFs.
IGRP0 = GRP__NOID
CALL KPG1_RGNDF( 'NDF', 0, 0, ' Give more NDFs...',
: IGRP0, SIZE0, STATUS )

* If no value was supplied for NDF, annull the error, and continue to use
* IGRP0 in place of IGRP1
IF( STATUS .EQ. PAR__NULL ) THEN
CALL GRP_DELET( IGRP0, STATUS )
CALL ERR_ANNUL( STATUS )
SIZE0 = 0
ELSE IF( SIZE0 .EQ. 0 ) THEN
CALL GRP_DELET( IGRP0, STATUS )
END IF

* Allow the user to modify the above group of existing NDFs, or to
* specify a group of NDFs that may not exist. Loop until a group
* expression is given which is not terminated by a flag character.
IGRP1 = GRP__NOID
FLAG = .TRUE.
DO WHILE( FLAG .AND. STATUS .EQ. SAI__OK )
CALL NDG_CREAT( 'MOD', IGRP0, IGRP1, SIZE1, FLAG, STATUS )
IF( FLAG ) THEN
CALL PAR_CANCL( 'MOD', STATUS )
CALL MSG_OUT( ' ', 'Please supply more values for '//
: 'parameter MOD.', STATUS )
END IF
END DO

* If no value was supplied for MOD, annull the error, and continue to use
* IGRP0 in place of IGRP1
IF( STATUS .EQ. PAR__NULL ) THEN
CALL GRP_DELET( IGRP1, STATUS )
CALL ERR_ANNUL( STATUS )
IGRP1 = IGRP0
IGRP0 = GRP__NOID
SIZE1 = SIZE0
END IF

* Only proceed if some NDFs were specified.
IF( SIZE1 .GT. 0 ) THEN

* See what the user wants to display.
CALL PAR_CHOIC( 'SHOW', 'PATH', 'SLICE,HDSPATH,FTYPE,BASE,'//
: 'DIR,PATH', .TRUE., SHOW, STATUS )
IF( SHOW .EQ. 'SLICE' ) THEN
ISHOW = 1
ELSE IF( SHOW .EQ. 'HDSPATH' ) THEN
ISHOW = 2
ELSE IF( SHOW .EQ. 'FTYPE' ) THEN
ISHOW = 3
ELSE IF( SHOW .EQ. 'BASE' ) THEN
ISHOW = 4
ELSE IF( SHOW .EQ. 'DIR' ) THEN
ISHOW = 5
ELSE
ISHOW = 6
END IF

* Write the group size to an output parameter.
CALL PAR_PUT0I( 'SIZE', SIZE, STATUS )
CALL PAR_PUT0I( 'SIZE', SIZE1, STATUS )

* Abort if an error has occurred.
IF( STATUS .NE. SAI__OK ) GO TO 999
IF( STATUS .NE. SAI__OK ) GO TO 999

* Get the index of the first NDF to display.
CALL PAR_GDR0I( 'FIRST', 0, 1, SIZE, .FALSE., FIRST, STATUS )
CALL PAR_GDR0I( 'FIRST', 0, 1, SIZE1, .FALSE., FIRST, STATUS )

* If a null value was supplied, annull the error and start from the
* first NDF in the group (Index 1). Also set the dynamic default for
* LAST to the last NDF in the group.
IF( STATUS .EQ. PAR__NULL ) THEN
CALL ERR_ANNUL( STATUS )
FIRST = 1
LAST = SIZE
IF( STATUS .EQ. PAR__NULL ) THEN
CALL ERR_ANNUL( STATUS )
FIRST = 1
LAST = SIZE1

* If a value was supplied for FIRST, use the same value as the dynamic
* default for LAST.
ELSE
LAST = FIRST
END IF
ELSE
LAST = FIRST
END IF

* Get the index of the last NDF to display, using the above dynamic
* default.
CALL PAR_GDR0I( 'LAST', LAST, FIRST, SIZE, .TRUE., LAST, STATUS )
CALL PAR_GDR0I( 'LAST', LAST, FIRST, SIZE1, .TRUE., LAST,
: STATUS )

* Loop round displaying the required NDFs.
DO I = FIRST, LAST
DO I = FIRST, LAST

* Get all items of information about the NDF.
CALL NDG_GTSUP( IGRP, I, FIELDS, STATUS )
* Get all items of information about the NDF.
CALL NDG_GTSUP( IGRP1, I, FIELDS, STATUS )

* Display the required item.
CALL MSG_SETC( 'I', FIELDS( ISHOW ) )
CALL MSG_OUT( ' ', '^I', STATUS )
* Display the required item.
CALL MSG_SETC( 'I', FIELDS( ISHOW ) )
CALL MSG_OUT( ' ', '^I', STATUS )

* Write the first NDF to an output parameter.
IF( I .EQ. FIRST ) THEN
ILEN = CHR_LEN( FIELDS( ISHOW ) )
IF( ILEN .EQ. 0 ) ILEN = 1
CALL PAR_PUT0C( 'VALUE', FIELDS( ISHOW )( : ILEN ), STATUS )
END IF
IF( I .EQ. FIRST ) THEN
ILEN = CHR_LEN( FIELDS( ISHOW ) )
IF( ILEN .EQ. 0 ) ILEN = 1
CALL PAR_PUT0C( 'VALUE', FIELDS( ISHOW )( : ILEN ),
: STATUS )
END IF

END DO
END DO

END IF

* Tidy up.
* ========
999 CONTINUE

* Free resourcee.
CALL GRP_DELET( IGRP, STATUS )
IF( IGRP0 .NE. GRP__NOID ) CALL GRP_DELET( IGRP0, STATUS )
IF( IGRP1 .NE. GRP__NOID ) CALL GRP_DELET( IGRP1, STATUS )

* Add a context report if anything went wrong.
IF ( STATUS .NE. SAI__OK ) THEN
Expand Down

0 comments on commit 56828d7

Please sign in to comment.