include include include include include "rplotx.h" include # RPLOTX -- program to produce tadpole plots of reseau mark shifts # in various ways # # D. Giaretta, 01-Aug-1987 Original SPP version procedure t_rplotx() pointer rp pointer rentp char input1[SZ_FNAME] # entry file - without whitespace char input2[SZ_FNAME] # reference file - without whitespace char entry[SZ_R_PATTERN] # first entry/pattern char refentry[SZ_R_PATTERN] # reference entry char option[SZ_LINE] # plot option real mag # magnification factor real window[4] # window char device[SZ_FNAME] # graphics device #-- char reply[1], stat, getchar() # for delays before frame bool reffile # was separate ref file given? bool optall # all vectors on one plot? bool first # first time around loop? pointer rs_open() pointer rentpref # pointers for ref. res. coords pointer rpref # pointers for ref. file pointer rend # pointer for end vector structure pointer gp, gopen() # graphics stream real clgetr() pointer tempp bool rs_check() int kwindex, clgwrd() pointer rlist, rs_template() int rs_list(), rs_readr(), nowhite() errchk rs_open, rs_readr, rs_template, gopen errchk clgetr, clgwrd begin rp = NULL # get input1 and check for blanks call clgstr( "input1", input1, SZ_FNAME) if ( nowhite( input1, input1, SZ_FNAME) == 0 ) call error( 0, "input file must be given") call clgstr( "input2", input2, SZ_FNAME) if ( nowhite( input2, input2, SZ_FNAME) == 0 ) reffile = false else reffile = true # get entry defs call clgstr( "entry", entry, SZ_R_PATTERN) call clgstr( "refentry", refentry, SZ_R_PATTERN) # get options - check for all vectors on one plot kwindex = clgwrd( "option", option, SZ_LINE, ",all,sequential,ref") optall = false if ( kwindex == 1 ) optall = true else if ( kwindex == 2 && reffile ) # but we ignore input2 if sequential pairs reffile = false mag = clgetr( "magnification") window[1] = clgetr("x1") window[2] = clgetr("x2") window[3] = clgetr("y1") window[4] = clgetr("y2") call clgstr("device", device, SZ_FNAME] # open the files # first input1 rp = rs_open( input1, READ_ONLY, 0) # input2 if required if (reffile){ rpref = rs_open( input2, READ_ONLY, 0) # check if grid sizes the same if (!rs_check(rpref, RES_NROWS(rp), RES_NCOLS(rp)) ) call error (0, "input1 and input2 grid sizes must match") } else { # if no input2, set ref. pointer to input1 rpref = rp call strcpy( input1, input2, SZ_FNAME) } # open the device gp = gopen(device, NEW_FILE, STDGRAPH) # set the window etc call gsview( gp, RSV_X1, RSV_X2, RSV_Y1, RSV_Y2) call gsetr( gp, G_TXSIZE, 1.0) call gseti( gp, G_NTITLELINES, 6) GP_TITLEJUST(gp) = GT_LEFT ############## # G_TITLEJUST not implemented in gseti ####### call gseti( gp, G_TITLEJUST , GT_LEFT) call gsetr( gp, G_ASPECT, 1.0) # allocate space for reference, entry and vector ends call rs_alloc( rpref, TY_REAL, rentpref) call rs_alloc( rp, TY_REAL, rentp) call rs_alloc( rp, TY_REAL, rend) # read reference entry rlist = rs_template( rpref, refentry) if ( rs_readr( rpref, rentpref, EOS, rs_list(rlist) ) == RES_F_NONEXTENTRY ) call error( 0, "cannot read reference entry") # initialize loop rlist = rs_template( rp, entry) first = true # plot until we reach the end of chosen entries while ( rs_readr( rp, rentp, EOS, rs_list(rlist) ) != RES_F_NONEXTENTRY) { # wait for keystroke before starting next screen, if we are # going to plot more frames, but omit first time if (!first && !optall){ call printf( "press RETURN for next plot:") call flush(STDOUT) stat = getchar(reply) call gframe(gp) } # now plot call rs_plotx( gp, input1, input2, first, optall, entry, window, mag, option, rp, rentp, rpref, rentpref, Memr[RES_XPT(rentp)], Memr[RES_YPT(rentp)], Memb[RES_FPT(rentp)], Memr[RES_XPT(rentpref)], Memr[RES_YPT(rentpref)], Memb(RES_FPT(rentpref)], Memr[RES_XPT(rend)], Memr[RES_YPT(rend)], Memb(RES_FPT(rend)] ) # if we are plotting sequential pairs we must swop the # pointers if (option[1] == 's' ){ tempp = rentpref rentpref = rentp rentp = tempp } first = false } # close the graphics stream call gclose(gp) # close the files call rs_close(rp) call rs_close(rpref) end # RS_PLOTX -- plot reseau shift vectors procedure rs_plotx( gp, input1, input2, first, optall, entry, window, mag, option, rp, rentp, rpref, rentpref, x, y, f, xref, yref, fref, xend, yend, fend) pointer gp # i: graphics stream pointer char input1[SZ_FNAME] # i: name of input1 char input2[SZ_FNAME] # i: name of input2 bool first, optall # i: options flags char entry[SZ_R_PATTERN] # i: entry name to be printed real window[4] # i: plot extremes real mag # i: magnification factor char option[SZ_LINE] # i: option pointer rp, rpref # i: res. file pointers pointer rentp, rentpref # i: reference res. file pointers real x[ARB], xref[ARB], xend[ARB] # x coords real y[ARB], yref[ARB], yend[ARB] # y coords bool f[ARB], fref[ARB], fend[ARB] # null res. ? flags # true if bad point #-- char date[SZ_TIME], datetime[SZ_R_TIME] long ldate int nrows, ncols char title[RSV_LABLEN*6] char xlabel[RSV_LABLEN] char ylabel[RSV_LABLEN] char msg1[RSV_LABLEN], msg2[RSV_LABLEN] char msg3[RSV_LABLEN], msg4[RSV_LABLEN] char msg5[RSV_LABLEN], msg6[RSV_LABLEN] int i real twindow[4] long clktime() begin ncols = RES_ENT_NCOLS(rentp) nrows = RES_ENT_NROWS(rentp) # if we as just drawing first plot, or if we are not plotting # everything on one plot, initialise the window if (!optall || first){ do i = 1, 4 twindow[i] = window[i] # set window if ( IS_INDEFR (window[1]) ) twindow[1] = RES_ENT_SFIELD2(rentpref) if ( IS_INDEFR (window[2]) ) twindow[2] = RES_ENT_SFIELD4(rentpref) + RES_ENT_SFIELD2(rentpref) - 1.0 if ( IS_INDEFR (window[3]) ) twindow[3] = RES_ENT_SFIELD1(rentpref) if ( IS_INDEFR (window[4]) ) twindow[4] = RES_ENT_SFIELD3(rentpref) + RES_ENT_SFIELD1(rentpref) - 1.0 call gswind( gp, twindow[1], twindow[2], twindow[3], twindow[4] ) # set up headers for printing call sprintf( msg1, RSV_LABLEN, "diff file : %s \n") call pargstr( input1 ) if (!optall){ call rs_cnvtime( rentp, datetime, SZ_R_TIME) call sprintf( msg2, RSV_LABLEN, "run entry : %s , dated %s , history* %s *\n") call pargstr( RES_ENT_ENTRY(rentp) ) call pargstr( datetime ) call pargstr( RES_ENT_TRACKING(rentp) ) } else { call sprintf( msg2, RSV_LABLEN, "run entries: %s \n") call pargstr( entry ) } call sprintf( msg3, RSV_LABLEN, "ref file : %s \n") call pargstr( input2 ) call rs_cnvtime( rentp, datetime, SZ_R_TIME) call sprintf( msg4, RSV_LABLEN, "ref entry : %s , dated %s , history* %s *\n") call pargstr( RES_ENT_ENTRY(rentpref) ) call pargstr( datetime ) call pargstr( RES_ENT_TRACKING(rentpref) ) call sprintf( msg5, RSV_LABLEN, "magnif. : %13.6g\n") call pargr(mag) ldate = clktime(0) call cnvtime(ldate, date, SZ_TIME] call sprintf( msg6, RSV_LABLEN, "plotted : %s\n") call pargstr( date ) call strcpy( "PIXEL NUMBERS", xlabel, RSV_LABLEN) call strcpy( "LINE NUMBERS", ylabel, RSV_LABLEN) call strcpy( msg1, title, RSV_LABLEN*6) call strcat( msg2, title, RSV_LABLEN*6) call strcat( msg3, title, RSV_LABLEN*6) call strcat( msg4, title, RSV_LABLEN*6) call strcat( msg5, title, RSV_LABLEN*6) call strcat( msg6, title, RSV_LABLEN*6) # Plot the axes call glabax( gp, title, xlabel, ylabel) } # plot the difference vectors if (!optall){ for (i = 1; i<=ncols*nrows; i=i+1){ if (!f[i] && !fref[i]){ call gline( gp, xref[i], yref[i], xref[i]+mag*(x[i]-xref[i]), yref[i]+mag*(y[i]-yref[i]) ) call gmark( gp, xref[i], yref[i], GM_BOX, 1., 1.) } else if (!f[i] && fref[i]){ call gmark( gp, x[i], y[i], GM_POINT, 1., 1.) } else if (f[i] && !fref[i]){ call gmark( gp, xref[i], yref[i], GM_CROSS, 1., 1.) } } } else { # but if all on one plot we copy ref vectors to vector ends if (first){ for (i=1; i<=ncols*nrows; i=i+1){ xend[i] = xref[i] yend[i] = yref[i] fend[i] = fref[i] if (!fref[i]) call gmark( gp, xref[i], yref[i], GM_BOX, 1., 1.) } } # and draw vectors from last positions for (i=1; i<=ncols*nrows; i=i+1){ if (!f[i] && !fend[i]){ call gline( gp, xend[i], yend[i], xref[i]+mag*(x[i]-xref[i]), yref[i]+mag*(y[i]-yref[i]) ) xend[i] = xref[i] +mag*(x[i]-xref[i]) yend[i] = yref[i] +mag*(y[i]-yref[i]) } } } call gflush( gp) end