Sample GIPSY task source
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