include include include include define SQUARE 1 define RECTANGULAR 2 define GRID 3 define SKEW 4 # RGENX -- program to create reseau files from data in various forms # # D. Giaretta, 01-Aug-1987 Original SPP version # Phil Hodge, 17-July-1989 Rect option was trying to read too many values # Phil Hodge, 23-Mar-1992 Use access to check whether the input file is # a text file; if it's a binary table, check that # columns were found; call close or tbtclo when done; # change declared data types of fdcoord, open, getline. procedure t_rgenx() char output[SZ_FNAME] # output reseau char template[SZ_FNAME] # input reseau, if any char entry[SZ_R_ENTRY] # new entry name char coord_file[SZ_FNAME] # name of coord file - no whitespace int nrows, ncols # size of grid to create #-- bool inplace #is operation being performed inplace pointer rp, rpin # res. file structure pointers pointer rentp # new entry res. enrty structure pointer bool streq() int clgeti(), nowhite(), junk pointer rs_open() errchk immap, rs_open, rs_readr begin rpin = NULL rp = NULL nrows = 0 ncols = 0 call clgstr( "output", output, SZ_FNAME) if ( nowhite( output, output, SZ_FNAME) == 0 ) call error( 0, "Output file must be given") call clgstr( "template", template, SZ_FNAME) junk = nowhite( template, template, SZ_FNAME) call clgstr( "entry", entry, SZ_R_ENTRY) call clgstr("coordfile", coord_file, SZ_FNAME) if ( nowhite( coord_file, coord_file, SZ_FNAME) == 0 ) call error ( 0, " coord data must be in cursor or coord file") # see if operation is inplace if ( streq( template, output) ){ rp = rs_open( template, READ_WRITE, 0) inplace = true rpin = rp nrows = RES_NROWS(rp) ncols = RES_NCOLS(rp) # otherwise create new file }else { inplace = false if ( template[1] == EOS ){ rp = rs_open( output, NEW_FILE, 0) # read grid size since no template nrows = clgeti( "nrows") ncols = clgeti( "ncols") call rs_new( 1, 1, nrows, ncols, TY_REAL, rp) }else{ rpin = rs_open( template, READ_ONLY, 0) nrows = RES_NROWS(rpin) ncols = RES_NCOLS(rpin) rp = rs_open( output, NEW_COPY, rpin) } } # allocate space for coords call rs_alloc( rp, TY_REAL, rentp ) # read coords call xvgr_get_coord( rp, coord_file, Memr[RES_XPT(rentp)], Memr[RES_YPT(rentp)], Memb(RES_FPT(rentp)] ) # copy entry name to entry structure call strcpy( entry, RES_ENT_ENTRY(rentp), SZ_R_ENTRY) # set rest of entry structure call xvgr_set_info ( rp, rentp) # insert the new entry call rs_insert( rpin, rp, rentp ) # close the files call rs_close(rp) call rs_close(rpin) end # XVGR_GET_COORD -- Read coord info procedure xvgr_get_coord( rp, coord_file, x, y, f ) pointer rp # i: res. file pointer real x[ARB] # o: x coords real y[ARB] # o: y coords bool f[ARB] # o: is coord null? #-- char line[SZ_LINE] # line from text coord_file char grid_type[SZ_LINE] # grid type int ip, i_in_line # text line counters int ir, ic double dval # single value read pointer tpcur # pointer to cursor table struct int fdcoord # fd number for text file pointer coord # pointer to text fie coord array char coord_file[SZ_FNAME] # name of coord file - no whitespace int nrows, ncols # size of grid int numvals # number of values we expect to read - # based on gridtype and nrows, ncols pointer colptr[2] # col. pointers for cursor file coords bool nullflag[2] # is cursor coord null? bool finished # read enough vales? char xcol[SZ_LINE], ycol[SZ_LINE] # keywords for cursor file keywords real x_start, x_inc, y_start, y_inc # pointer tbtopn() int access(), open(), getline() int ctod(), tbpsta(), numrows, trow int kwindex, clgwrd() errchk tbrgtr, clgwrd, tbpsta begin nrows = RES_NROWS(rp) ncols = RES_NCOLS(rp) kwindex = clgwrd( "gridtype", grid_type, SZ_LINE, ",square,rectangle,grid,skew") # Set the number of values expected. Note that the number of rows # that we need in a table is only half of numvals. switch (kwindex) { case SQUARE: numvals = 4 case RECTANGULAR: numvals = ncols + nrows case GRID: numvals = 2 * ncols * nrows case SKEW: numvals = 6 default: call error( 0, "invalid option") } call salloc( coord, numvals, TY_REAL ) # If the file is a text file, open it as such, rather than # as a table. if (access (coord_file, 0, TEXT_FILE) == YES) { # read from coord text file, skipping lines begining with # i_in_line = 1 ip = 1 fdcoord = open( coord_file, READ_ONLY, TEXT_FILE) if (getline( fdcoord, line) == EOF){ call error( 0, "insufficient data in coordfile") }else{ for (ip = 1; ip <= numvals ; ip = ip + 1){ while (ctod(line, i_in_line, dval) < 1 || line[1] == '#'){ if (getline(fdcoord, line) == EOF) call error ( 0, "insufficient data in coordfile") else i_in_line = 1 } Memr[coord + ip -1] = dval } } call close (fdcoord) } else { tpcur = tbtopn( coord_file, READ_ONLY, 0) # open cursor table numvals = numvals / 2 # number of rows to read numrows = tbpsta( tpcur, TBL_NROWS) # total number of rows call clgstr( "xcol", xcol, SZ_LINE) call clgstr( "ycol", ycol, SZ_LINE) call tbcfnd( tpcur, xcol, colptr[1], 1) call tbcfnd( tpcur, ycol, colptr[2], 1) if (colptr[1] == NULL || colptr[2] == NULL) { call tbtclo (tpcur) call error (1, "column(s) not found in cursor table") } ip = 0 trow = 0 finished = false while ( !finished){ trow = trow + 1 if ( trow > numrows ) call error(0, "insufficient data in table file") call tbrgtr( tpcur, colptr, Memr[coord+2*ip], nullflag, 2, trow) if (!nullflag[1] && !nullflag[2]){ ip = ip + 1 if (ip >= numvals ) finished = true } } call tbtclo (tpcur) } #insert grid points into arrays if ( kwindex == SQUARE ){ x_start = Memr[coord] y_start = Memr[coord + 2] x_inc = (Memr[coord+1] - x_start)/max(ncols-1, 1) y_inc = (Memr[coord+3] - y_start)/max(nrows-1, 1) for (ir = 1; ir <= nrows ; ir = ir + 1){ for (ic = 1; ic <= ncols ; ic = ic + 1){ ip = (ir-1)*ncols+ic x[ip] = x_start + (ic-1)*x_inc y[ip] = y_start + (ir-1)*y_inc f[ip] = false } } }else if ( kwindex == RECTANGULAR ) { for (ir = 1; ir <= nrows ; ir = ir + 1){ for (ic = 1; ic <= ncols ; ic = ic + 1){ ip = (ir-1)*ncols+ic x[ip] = Memr[coord + ic-1] y[ip] = Memr[coord + ncols + ir-1] f[ip] = false } } }else if ( kwindex == GRID ) { for (ir = 1; ir <= nrows ; ir = ir + 1){ for (ic = 1; ic <= ncols ; ic = ic + 1){ ip = (ir-1)*ncols+ic x[ip] = Memr[coord + 2*ip-2] y[ip] = Memr[coord + 2*ip-1] f[ip] = false } } } else if ( kwindex == SKEW ) { for (ir = 1; ir <= nrows ; ir = ir + 1){ for (ic = 1; ic <= ncols ; ic = ic + 1){ ip = (ir-1)*ncols+ic x[ip] = Memr[coord] + (ic-1)*Memr[coord+1]+(ir-1)*Memr[coord+2] y[ip] = Memr[coord+3] + (ic-1)*Memr[coord+4]+(ir-1)*Memr[coord+5] f[ip] = false } } } else { call error(0, "invalid grid type") } end # XVGR_SET_INFO -- set reseau entry info procedure xvgr_set_info(rp, rentp) pointer rp # i: res pointer pointer rentp # i: entry pointer #-- long clktime() real clgetr() begin call strcpy( "V", RES_ENT_TRACKING(rentp), SZ_R_TRACKING) RES_ENT_DATE( rentp) = clktime(0) RES_ENT_NROWS(rentp) = RES_NROWS(rp) RES_ENT_NCOLS(rentp) = RES_NCOLS(rp) RES_ENT_SFIELD1(rentp) = clgetr("sfield1") RES_ENT_SFIELD2(rentp) = clgetr("sfield2") RES_ENT_SFIELD3(rentp) = clgetr("sfield3") RES_ENT_SFIELD4(rentp) = clgetr("sfield4") end