The code below has been written in Sheltran, GIPSY's Fortran pre-processor language.

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