Sample GIPSY task source

      PROGRAM EXAMPLE2
C
C     Demo program which multiplies the input data by two inside and
C     by three outside the frame defined by the user.
C
N     Maximum number of axes in a GDS set
      INTEGER MAXAXES
      PARAMETER (MAXAXES = 10)
N     Maximum number of subsets
      INTEGER MAXSUBS
      PARAMETER (MAXSUBS = 2048)
N     Size of internal data buffer
      INTEGER MAXDATA
      PARAMETER (MAXDATA = 4096)
N     Names of input and output set
      CHARACTER*80 SET1, SET2
N     Dimension of subsets
      INTEGER      SUBDIM
N     Number of subsets
      INTEGER      NSUBS
N     Array containing axis permutation
      INTEGER      AXPERM1(MAXAXES), AXPERM2(MAXAXES)
N     Array containing axis counts
      INTEGER      AXCOUNT1(MAXAXES), AXCOUNT2(MAXAXES)
N     Arrays for input and output subsets
      INTEGER      SUBSET1(MAXSUBS), SUBSET2(MAXSUBS)
N     Arrays containing lower and upper grids of frame
      INTEGER      FLO(MAXAXES), FHI(MAXAXES)
N     Arrays containing lower and upper grids of subframe
      INTEGER      BLO(MAXAXES), BHI(MAXAXES)
N     Coordinate words
      INTEGER      CWLO, CWUP
N     GDS error returns
      INTEGER      GERROR
N     Transfer identifiers
      INTEGER      TID1, TID2
N     Number of pixels just read in buffer
      INTEGER      NREAD
N     Number of pixels just written to disk
      INTEGER      NWRITE
N     Counter for INITPTR
      INTEGER      NT
N     Various
      INTEGER      N, NS, IP, NP
N     System defined BLANK
      REAL         BLANK
N     Internal data buffer
      REAL         DATR(MAXDATA)
N     Function which gets input set and subsets
      INTEGER      GDSINP
N     Function which gets output set and subsets
      INTEGER      GDSOUT
N     Function which fills coordinate word
      INTEGER      GDSC_FILL
N     Extracts grid from coordinate word
      INTEGER      GDSC_GRID
N     Pointer functions
      LOGICAL      INSIDEPTR, OUTSIDEPTR
C     Executable code:
      CALL INIT
N     Zero GDS error return code
      GERROR = 0
N     No required dimension of subset
      SUBDIM = 0
N     Get input set and subsets from user
      NSUBS = GDSINP( SET1, SUBSET1, MAXSUBS, 0, 'SET=',
     #                'Give input set (and subsets)',
     #                11, AXPERM1, AXCOUNT1, MAXAXES, 1, SUBDIM )
N     Now get subframe of subset
      CALL GDSBOX( BLO, BHI, SET1, SUBSET1(1), 1, ' ', ' ', 11, 0 )
N     Prepare for GDSOUT
      CALL GDSASN( 'SET=', 'SETOUT=', 1 )
N     Get output set and subsets from user
      NSUBS = GDSOUT( SET2, SUBSET2, NSUBS, 0, 'SETOUT=',
     #                'Give output set (and subsets)',
     #                11, AXPERM2, AXCOUNT2, MAXAXES )
N     Fill subset coordinate word with whole range
      CALL GDSC_RANGE( SET1, SUBSET1(1), CWLO, CWUP, GERROR )
N     Now we need the grid coordinates of the subset frame
      FOR N = 1, SUBDIM
        FLO(N) = GDSC_GRID( SET1, AXPERM1(N), CWLO, GERROR )
        FHI(N) = GDSC_GRID( SET1, AXPERM1(N), CWUP, GERROR )
      CFOR
N     Get system defined BLANK
      CALL SETFBLANK( BLANK )
N     Integrate each subset
      FOR NS = 1, NSUBS
N       Show user what subsets we are working on
        CALL SHOWSUB2( SET1, SUBSET1(NS), AXPERM1,
     #                 SET2, SUBSET2(NS), AXPERM2 )
N       Get coordinate words of lower and upper edge of frame
        CWLO = GDSC_FILL( SET1, SUBSET1(NS), FLO )
N       GDSC_FILL fills in the undefined dimensions from grid array
        CHUP = GDSC_FILL( SET1, SUBSET1(NS), FHI )
N       Reset read transfer identifier
        TID1 = 0
N       Reset write transfer identifier
        TID2 = 0
N       Reset counter for INITPTR
        NT = 0
N       Loop until all data scaled
        REPEAT
N         Read data
          CALL GDSI_READ( SET1, CWLO, CWUP, DATR, MAXDATA, NREAD, TID1 )
N         Initialize INSIDEPTR/OUTSIDEPTR with INITPTR
          CALL INITPTR( FLO, FHI, BLO, BHI, SUBDIM, NREAD, NT )
N         IP is a pointer to pixel inside subframe
N         NP is number of pixels inside subframe starting at IP
          WHILE (INSIDEPTR( IP, NP ))
            FOR N = 1, NP
              IF (BLANK .NE. DATR(N+IP))
              THEN
N               Inside subframe multiply by 2.0
                DATR(N+IP) = 2.0 * DATR(N+IP)
              CIF
            CFOR
          CWHILE
N         IP is a pointer to pixel outside subframe
N         NP is number of pixels outside subframe starting at IP
          WHILE (OUTSIDEPTR( IP, NP ))
            FOR N = 1, NP
              IF (BLANK .NE. DATR(N+IP))
              THEN
N               Outside subframe multiply by 3.0
                DATR(N+IP) = 3.0 * DATR(N+IP)
              CIF
            CFOR
          CWHILE
N         Write back scaled data
          CALL GDSI_WRITE( SET2, CWLO, CWUP, DATR, NREAD, NWRITE, TID2 )
        UNTIL (TID1 .EQ. 0)
      CFOR
      CALL FINIS
      STOP
      END