diff options
| author | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
|---|---|---|
| committer | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
| commit | 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch) | |
| tree | 4464880c571602d54f6ae114729bf62a89518057 /sys/gio/ncarutil/tests | |
| download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz | |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'sys/gio/ncarutil/tests')
60 files changed, 5871 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/tests/README b/sys/gio/ncarutil/tests/README new file mode 100644 index 00000000..d74bb65f --- /dev/null +++ b/sys/gio/ncarutil/tests/README @@ -0,0 +1,2 @@ +This directory contains test routines for the NCAR utilities. The files +ending with "t.f" are the NCAR supplied fortran test routines. diff --git a/sys/gio/ncarutil/tests/auto10t.f b/sys/gio/ncarutil/tests/auto10t.f new file mode 100644 index 00000000..26109f4f --- /dev/null +++ b/sys/gio/ncarutil/tests/auto10t.f @@ -0,0 +1,262 @@ + SUBROUTINE XMPL10 +C +C Define the data arrays. +C + REAL XDRA(1201),YDRA(1201) +C +C Fill the data arrays. The independent variable represents time during +C the year (a hypothetical year with equal-length months) and is set up +C so that the minor ticks can be lengthened to delimit the months; the +C major ticks, though shortened to invisibility, will determine where +C the labels go. +C + DO 101 I=1,1201 + XDRA(I)=FLOAT(I-51) + YDRA(I)=COSH(FLOAT(I-601)/202.) + 101 CONTINUE +C +C Change the labels on the bottom and left axes. +C + CALL ANOTAT ('MONTHS OF THE YEAR$','ROMAN NUMERALS$',0,0,0,0) +C +C Fix the minimum and maximum values on both axes and prevent AUTOGRAPH +C from using rounded values at the ends of the axes. +C + CALL AGSETF ('X/MIN.',-50.) + CALL AGSETF ('X/MAX.',1150.) + CALL AGSETI ('X/NICE.',0) +C + CALL AGSETF ('Y/MIN.',1.) + CALL AGSETF ('Y/MAX.',10.) + CALL AGSETI ('Y/NICE.',0) +C +C Specify the spacing between major tick marks on all axes. Note that +C the AUTOGRAPH dummy routine AGCHNL is supplanted (below) by one which +C supplies dates for the bottom axis and Roman numerals for the left +C axis in place of the numeric labels one would otherwise get. +C + CALL AGSETI (' LEFT/MAJOR/TYPE.',1) + CALL AGSETI (' RIGHT/MAJOR/TYPE.',1) + CALL AGSETI ('BOTTOM/MAJOR/TYPE.',1) + CALL AGSETI (' TOP/MAJOR/TYPE.',1) +C + CALL AGSETF (' LEFT/MAJOR/BASE.', 1.) + CALL AGSETF (' RIGHT/MAJOR/BASE.', 1.) + CALL AGSETF ('BOTTOM/MAJOR/BASE.',100.) + CALL AGSETF (' TOP/MAJOR/BASE.',100.) +C +C Suppress minor ticks on the left and right axes. +C + CALL AGSETI (' LEFT/MINOR/SPACING.',0) + CALL AGSETI (' RIGHT/MINOR/SPACING.',0) +C +C On the bottom and top axes, put one minor tick between each pair of +C major ticks, shorten the major ticks to invisibility, and lengthen +C the minor ticks. The net effect is to make the minor ticks delimit +C the beginning and end of each month, while the major ticks, though +C invisible, cause the names of the months to be where we want them. +C + CALL AGSETI ('BOTTOM/MINOR/SPACING.',1) + CALL AGSETI (' TOP/MINOR/SPACING.',1) +C + CALL AGSETF ('BOTTOM/MAJOR/INWARD. ',0.) + CALL AGSETF ('BOTTOM/MINOR/INWARD. ',.015) + CALL AGSETF (' TOP/MAJOR/INWARD. ',0.) + CALL AGSETF (' TOP/MINOR/INWARD. ',.015) +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Draw the graph, using EZXY. +C + CALL EZXY (XDRA,YDRA,1201,'EXAMPLE 10 (MODIFIED NUMERIC LABELS)$') +C +c STOP +C + END + SUBROUTINE AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE) +C + CHARACTER*(*) CHRM,CHRE +C +C The routine AGCHNL is called by AGAXIS just after it has set up the +C character strings comprising a numeric label along an axis. The +C default version does nothing. A user may supply his own version to +C change the numeric labels. For each numeric label, this routine is +C called twice by AGAXIS - once to determine how much space will be +C required when the label is actually drawn and once just before it +C is actually drawn. The arguments are as follows: +C +C - IAXS is the number of the axis being drawn. Its value is 1, 2, 3, +C or 4, implying the left, right, bottom, or top axes, respectively. +C The value of IAXS must not be altered. +C +C - VILS is the value to be represented by the numeric label, in the +C label system for the axis. The value of VILS must not be altered. +C +C - CHRM, on entry, is a character string containing the mantissa of the +C numeric label, as it will appear if AGCHNL makes no changes. If the +C numeric label includes a "times" symbol, it will be represented by +C a blank in CHRM. (See IPXM, below.) CHRM may be modified. +C +C - MCIM is the length of CHRM - the maximum number of characters that +C it will hold. The value of MCIM must not be altered. +C +C - NCIM, on entry, is the number of meaningful characters in CHRM. If +C CHRM is changed, NCIM should be changed accordingly. +C +C - IPXM, on entry, is zero if there is no "times" symbol in CHRM; if it +C is non-zero, it is the index of the appropriate character position +C in CHRM. If AGCHNL changes the position of the "times" symbol in +C CHRM, removes it, or adds it, the value of IPXM must be changed. +C +C - CHRE, on entry, is a character string containing the exponent of the +C numeric label, as it will appear if AGCHNL makes no changes. CHRE +C may be modified. +C +C - MCIE is the length of CHRE - the maximum number of characters that +C it will hold. The value of MCIE must not be altered. +C +C - NCIE, on entry, is the number of meaningful characters in CHRE. If +C CHRE is changed, NCIE should be changed accordingly. +C +C Define the names of the months for use on the bottom axis. +C + CHARACTER*3 MONS(12) + DATA MONS / 'JAN','FEB','MAR','APR','MAY','JUN', + + 'JUL','AUG','SEP','OCT','NOV','DEC'/ +C +C Modify the numeric labels on the left axis. +C + IF (IAXS.EQ.1) THEN + CALL AGCORN (IFIX(VILS),CHRM,NCIM) + IPXM=0 + NCIE=0 +C +C Modify the numeric labels on the bottom axis. +C + ELSE IF (IAXS.EQ.3) THEN + IMON=IFIX(VILS+.5)/100+1 + CHRM(1:3)=MONS(IMON) + NCIM=3 + IPXM=0 + NCIE=0 + END IF +C +C Done. +C + RETURN +C + END + SUBROUTINE AGCORN (NTGR,BCRN,NCRN) +C + CHARACTER*(*) BCRN +C +C This routine receives an integer in NTGR and returns its Roman-numeral +C equivalent - NCRN characters - in the character variable BCRN. It +C only works for integers within a limited range and it does some rather +C unorthodox things (like using zero and minus). +C +C ICH1, ICH5, and IC10 are character variables used for the single-unit, +C five-unit, and ten-unit symbols at a given level. +C + CHARACTER*1 ICH1,ICH5,IC10 +C +C Treat numbers outside the range (-4000,+4000) as infinites. +C + IF (IABS(NTGR).GE.4000) THEN + IF (NTGR.GT.0) THEN + NCRN=5 + BCRN(1:5)='(INF)' + ELSE + NCRN=6 + BCRN(1:6)='(-INF)' + END IF + RETURN + END IF +C +C Use the symbol '0' for the zero. The Romans never had it so good. +C + IF (NTGR.EQ.0) THEN + NCRN=1 + BCRN(1:1)='0' + RETURN + END IF +C +C Zero the character counter. +C + NCRN=0 +C +C Handle negative integers by prefixing a minus sign. +C + IF (NTGR.LT.0) THEN + NCRN=NCRN+1 + BCRN(NCRN:NCRN)='-' + END IF +C +C Initialize some constants. We'll check for thousands first. +C + IMOD=10000 + IDIV=1000 + ICH1='M' +C +C Find out how many thousands (hundreds, tens, units) there are and jump +C to the proper code block for each case. +C + 101 INTG=MOD(IABS(NTGR),IMOD)/IDIV +C + GO TO (107,104,104,104,102,103,103,103,103,106) , INTG+1 +C +C Four - add ICH1 followed by ICH5. +C + 102 NCRN=NCRN+1 + BCRN(NCRN:NCRN)=ICH1 +C +C Five through eight - add ICH5, followed by INTG-5 ICH1's. +C + 103 NCRN=NCRN+1 + BCRN(NCRN:NCRN)=ICH5 +C + INTG=INTG-5 + IF (INTG.LE.0) GO TO 107 +C +C One through three - add that many ICH1's. +C + 104 DO 105 I=1,INTG + NCRN=NCRN+1 + BCRN(NCRN:NCRN)=ICH1 + 105 CONTINUE +C + GO TO 107 +C +C Nine - add ICH1, followed by IC10. +C + 106 NCRN=NCRN+1 + BCRN(NCRN:NCRN)=ICH1 + NCRN=NCRN+1 + BCRN(NCRN:NCRN)=IC10 +C +C If we're done, exit. +C + 107 IF (IDIV.EQ.1) RETURN +C +C Otherwise, tool up for the next digit and loop back. +C + IMOD=IMOD/10 + IDIV=IDIV/10 + IC10=ICH1 +C + IF (IDIV.EQ.100) THEN + ICH5='D' + ICH1='C' + ELSE IF (IDIV.EQ.10) THEN + ICH5='L' + ICH1='X' + ELSE + ICH5='V' + ICH1='I' + END IF +C + GO TO 101 +C + END diff --git a/sys/gio/ncarutil/tests/autograph.x b/sys/gio/ncarutil/tests/autograph.x new file mode 100644 index 00000000..3c2ccb14 --- /dev/null +++ b/sys/gio/ncarutil/tests/autograph.x @@ -0,0 +1,33 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> +include <ctype.h> + +# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc. + +procedure t_autograph() + +char device[SZ_FNAME], command[SZ_LINE] +int ierror, wkid, junk, cmd +int ctoi() +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tautog (ierror) + if (ierror == 0) + call eprintf ("Test successful\n") + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/autographt.f b/sys/gio/ncarutil/tests/autographt.f new file mode 100644 index 00000000..25b14518 --- /dev/null +++ b/sys/gio/ncarutil/tests/autographt.f @@ -0,0 +1,186 @@ + SUBROUTINE TAUTOG (IERROR) +C +C LATEST REVISION FEBRUARY 1985 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C AUTOGRAPH AND TO TEST AUTOGRAPH ON A +C SIMPLE PROBLEM +C +C USAGE CALL TAUTOG (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN ERROR PARAMETER +C = 0, IF THE TEST IS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C AUTOGRAPH TEST SUCCESSFUL . . . SEE PLOT +C TO VERIFY PERFORMANCE +C +C IS WRITTEN ON UNIT 6. +C +C IN ADDITION, FOUR (4) LABELLED FRAMES +C CONTAINING THE TWO-DIMENSIONAL PLOTS ARE +C PRODUCED ON THE MACHINE GRAPHICS DEVICE. +C TO DETERMINE IF THE TEST WAS SUCCESSFUL, +C IT IS NECESSARY TO EXAMINE THESE PLOTS. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY AUTOGRAPH +C FILES +C +C LANGUAGE FORTRAN +C +C HISTORY ORIGINALLY WRITTEN IN APRIL, 1979 AND +C CONVERTED TO FORTRAN 77 AND GKS IN FEBRUARY +C 1985. +C +C ALGORITHM TAUTOG COMPUTES DATA FOR AUTOGRAPH SUBROUTINES +C +C EZY, EZXY, EZMY, AND EZMXY, +C +C AND CALLS EACH OF THESE ROUTINES TO PRODUCE +C ONE PLOT EACH. +C +C ON THREE OF THE PLOTS, TAUTOG USES THE +C AUTOGRAPH CONTROL PARAMETER ROUTINES +C AGSETF, AGSETI, AND AGSETP TO SPECIFY +C Y-AXIS LABELS OR INTRODUCE LOG SCALING. +C +C PORTABILITY FORTRAN 77 +C + REAL X(21) ,Y1D(21) ,Y2D(21,5) +C +C X CONTAINS THE ABSCISSA VALUES FOR THE PLOTS PRODUCED BY EZXY AND +C EZMXY, Y1D CONTAINS THE ORDINATE VALUES FOR THE PLOTS PRODUCED BY +C EZXY AND EZY, AND Y2D CONTAINS THE ORDINATE VALUES FOR THE PLOTS +C PRODUCED BY EZMY AND EZMXY. +C +C +C +C +C FILL Y1D ARRAY FOR ENTRY EZY +C + DO 10 I=1,21 + Y1D(I) = EXP(-.1*FLOAT(I))*COS(FLOAT(I)*.5) + 10 CONTINUE +C +C ENTRY EZY PLOTS THE CONTENTS OF Y1D AS A FUNCTION OF THE INTEGERS +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATING EZY ENTRY OF AUTOGRAPH +C + CALL EZY (Y1D(1),21,'DEMONSTRATING EZY ENTRY OF AUTOGRAPH$') +C + +C +C +C +C FILL X AND Y1D ARRAYS FOR ENTRY EZXY +C + DO 20 I=1,21 + X(I) = FLOAT(I-1)*.314 + Y1D(I) = X(I)+COS(X(I))*2.0 + 20 CONTINUE +C +C SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL +C X+COS(X)*2 +C + CALL AGSETC('LABEL/NAME.','L') + CALL AGSETI('LINE/NUMBER.',100) + CALL AGSETC('LINE/TEXT.','X+COS(X)*2$') +C +C ENTRY EZXY PLOTS CONTENTS OF X-ARRAY VS. Y1D-ARRAY +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATING EZXY ENTRY OF AUTOGRAPH +C + CALL EZXY (X,Y1D,21,'DEMONSTRATING EZXY ENTRY IN AUTOGRAPH$') +C +C +C +C +C FILL Y2D ARRAY FOR ENTRY EZMY +C + DO 40 I=1,21 + T = .5*FLOAT(I-1) + DO 30 J=1,5 + Y2D(I,J) = EXP(-.5*T)*COS(T)/FLOAT(J) + 30 CONTINUE + 40 CONTINUE +C +C SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL +C EXP(-X/2)*COS(X)*SCALE +C + CALL AGSETC('LABEL/NAME.','L') + CALL AGSETI('LINE/NUMBER.',100) + CALL AGSETC('LINE/TEXT.','EXP(-X/2)*COS(X)*SCALE$') +C +C SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE +C ALPHABETIC SET OF DASHED LINE PATTERNS IS TO BE USED. +C + CALL AGSETI('DASH/SELECTOR.',-1) +C +C SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE +C GRAPH DRAWN IS TO BE LOGARITHMIC IN THE X-AXIS. +C + CALL AGSETI('X/LOGARITHMIC.',1) +C +C ENTRY EZMY PLOTS MULTIPLE ARRAYS AS A FUNCTION OF THE INTEGERS +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATING EZMY ENTRY OF AUTOGRAPH +C + CALL EZMY (Y2D,21,5,10,'DEMONSTRATING EZMY ENTRY OF AUTOGRAPH$') +C +C +C +C +C FILL Y2D ARRAY FOR EZMXY +C + DO 60 I=1,21 + DO 50 J=1,5 + Y2D(I,J) = X(I)**J+COS(X(I)) + 50 CONTINUE + 60 CONTINUE +C +C SET AUTOGRAPH CONTROL PARAMETERS FOR Y-AXIS LABEL +C X**J+COS(X) +C + CALL AGSETC('LABEL/NAME.','L') + CALL AGSETI('LINE/NUMBER.',100) + CALL AGSETC('LINE/TEXT.','X**J+COS(X)$') +C +C SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE +C ALPHABETIC SET OF DASHED LINE PATTERNS IS TO BE USED. +C + CALL AGSETI('DASH/SELECTOR.',-1) +C +C SET AUTOGRAPH CONTROL PARAMETER FOR SPECIFYING THAT THE GRAPH +C IS TO BE LINEAR IN THE X-AXIS AND LOGARITHMIC IN THE Y-AXIS. +C + CALL AGSETI('X/LOGARITHMIC.',0) + CALL AGSETI('Y/LOGARITHMIC.',1) +C +C ENTRY EZMXY PLOTS MULTIPLE ARRAYS AS A FUNCTION OF A SINGLE +C X ARRAY (OR MANY X ARRAYS) +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATING EZMXY ENTRY OF AUTOGRAPH +C + CALL EZMXY (X,Y2D,21,5,21, + + 'DEMONSTRATING EZMXY ENTRY OF AUTOGRAPH$') +C + IERROR = 0 +c WRITE (6,1001) +C + RETURN +C +c1001 FORMAT (' AUTOGRAPH TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/conran.x b/sys/gio/ncarutil/tests/conran.x new file mode 100644 index 00000000..11a4ab0d --- /dev/null +++ b/sys/gio/ncarutil/tests/conran.x @@ -0,0 +1,37 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# T_CONRAN -- test NCAR contour routine CONRAN. + +procedure t_conran () + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tconan (error_code) + if (error_code == 0) + call printf ("Test successful\n") + else { + call printf ("Test was not successful. ierror = %d\n") + call pargi (error_code) + } + + call gdawk (wkid) + call gclwk (wkid) + call gclks () + +end diff --git a/sys/gio/ncarutil/tests/conrant.f b/sys/gio/ncarutil/tests/conrant.f new file mode 100644 index 00000000..a144de35 --- /dev/null +++ b/sys/gio/ncarutil/tests/conrant.f @@ -0,0 +1,97 @@ + SUBROUTINE TCONAN (IERROR) +C +C LATEST REVISION JULY 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C CONRAN, THE STANDARD ENTRY POINT OF THE +C CONRAN PACKAGE. +C +C THIS SAME SUBROUTINE CAN BE USED TO PRODUCE +C DEMO PLOTS OF THE SMOOTH VERSION OF CONRAN +C BY LOADING DASHSMTH INSTEAD OF DASHCHAR. +C +C USAGE CALL TCONAN (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C .EQ. 0, IF THE TEST WAS SUCCESSFUL, +C .NE. 0, OTHERWISE +C IF NOT ZERO THE NUMBER PRODUCED WILL +C CORRESPOND TO THE ERROR NUMBERS IN +C THE CONRAN LISTING. +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C CONRAN TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR +C PLOT AND TRIANGULATION OF THE DATA ARE PRODUCED +C ON THE DEFAULT GRAPHICS DEVICE UNLESS THE USER +C SPECIFIES OTHERWISE VIA JCL. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY CONRAN +C FILES CONTERP +C CONCOM +C +C LANGUAGE FORTRAN77 +C +C ALGORITHM A SPARSE DATA SET IS DEFINED VIA DATA +C STATEMENTS. OPTIONS ARE SET TO PRODUCE A +C TITLE AND DISPLAY THE TRIANGULATION GENERATED +C BY THE INTERPOLATING ROUTINES. BY DEFAULT +C A MESSAGE AT THE BOTTEM OF THE PLOT AND A +C PERIMETER ARE ALSO PRODUCED. THIS ROUTINE +C TAKES ADVANTAGE OF THE PORT ERROR HANDLING +C ROUTINES TO DETERMINE IF CONRAN TERMINATED +C NORMALLY. +C +C PORTABILITY ANSI FORTRAN77 STANDARD +C +C COMMON /RANINT/ IRANMJ, IRANMN, IRANTX +C SET UP THE SCRATCH SPACES REQUIRED BY CONRAN +C + DIMENSION WK(221),IWK(744),SCR(1600) +C +C SET UP THE ARRAYS TO DEFINE THE DATA SET +C + DIMENSION XD(17),YD(17),ZD(17) +C +C DEFINE THE DATA SET +C + DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8), + 1 XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15), + 2 XD(16),XD(17) + 3 /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20., + 4 5.,15.,10.,7.,13.,16./ +C + DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8), + 1 YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15), + 2 YD(16),YD(17) + 3 /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10., + 4 15.,15.,15.,20.,20.,8./ +C + DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8), + 1 ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15), + 2 ZD(16),ZD(17) + 3 /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1., + 4 1.,1.,1.,1.,1.,25./ +C +C SET UP PARAMETER FOR NUMBER OF INPUT POINTS +C + DATA NDP/17/ + call conbdn +C +C SET UP TITLE FOR PLOT +C + CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAN',29, 0) +C + CALL CONRAN(XD,YD,ZD,NDP,WK,IWK,SCR) +C + RETURN + END diff --git a/sys/gio/ncarutil/tests/conraq.x b/sys/gio/ncarutil/tests/conraq.x new file mode 100644 index 00000000..d0480e97 --- /dev/null +++ b/sys/gio/ncarutil/tests/conraq.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# T_CONRAQ -- test NCAR contour routine CONRAQ. + +procedure t_conraq () + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tconaq (error_code) + if (error_code == 0) + call printf ("Test successful\n") + else + call printf ("Test was not successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () + +end diff --git a/sys/gio/ncarutil/tests/conraqt.f b/sys/gio/ncarutil/tests/conraqt.f new file mode 100644 index 00000000..dbf211aa --- /dev/null +++ b/sys/gio/ncarutil/tests/conraqt.f @@ -0,0 +1,139 @@ + SUBROUTINE TCONAQ (IERROR) +C +C LATEST REVISION JULY 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C CONRAQ, THE QUICK ENTRY POINT OF THE +C CONRAN PACKAGE. +C +C USAGE CALL TCONAQ (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C .EQ. 0, IF THE TEST WAS SUCCESSFUL, +C .NE. 0, OTHERWISE. +C IF NOT ZERO THE NUMBER PRODUCED WILL +C CORRESPOND TO THE ERROR NUMBERS IN +C THE CONRAQ LISTING. +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C CONRAQ TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR +C PLOT AND TRIANGULATION OF THE DATA ARE PRODUCED +C ON THE DEFAULT GRAPHICS DEVICE UNLESS THE USER +C SPECIFIES OTHERWISE VIA JCL. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY CONRAQ +C FILES CONTERP +C +C LANGUAGE FORTRAN77 +C +C ALGORITHM A SPARSE DATA SET IS DEFINED VIA DATA +C STATEMENTS. OPTIONS ARE SET TO PRODUCE A +C TITLE AND DISPLAY THE TRIANGULATION GENERATED +C BY THE INTERPOLATING ROUTINES. BY DEFAULT +C A MESSAGE AT THE BOTTEM OF THE PLOT AND A +C PERIMETER ARE ALSO PRODUCED. THIS ROUTINE +C TAKES ADVANTAGE OF THE PORT ERROR HANDLING +C ROUTINES TO DETERMINE IF CONRAQ TERMINATED +C NORMALLY. +C + COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX +C +C SET UP THE SCRATCH SPACES REQUIRED BY CONRAQ +C + DIMENSION WK(221),IWK(744) +C +C SET UP THE ARRAYS TO DEFINE THE DATA SET +C + DIMENSION XD(17),YD(17),ZD(17) +C +C DEFINE THE DATA SET +C + DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8), + 1 XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15), + 2 XD(16),XD(17) + 3 /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20., + 4 5.,15.,10.,7.,13.,16./ +C + DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8), + 1 YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15), + 2 YD(16),YD(17) + 3 /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10., + 4 15.,15.,15.,20.,20.,8./ +C + DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8), + 1 ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15), + 2 ZD(16),ZD(17) + 3 /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1., + 4 1.,1.,1.,1.,1.,25./ +C +C SET UP PARAMETER FOR NUMBER OF INPUT POINTS +C + DATA NDP/17/ +C +C SET PORT ERROR HANDLING ROUTINE TO RECOVERY MODE +C + CALL ENTSR(IROLD,1) +C +C SET UP TITLE FOR PLOT +C + CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAQ',29) +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C SET OPTION TO DISPLAY THE TRIANGULATION +C + CALL CONOP1('TRI=ON') +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C CALL CONRAQ TO CONTOUR DATA +C + CALL CONRAQ(XD,YD,ZD,NDP,WK,IWK) +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C +C CALL FRAME, CONRAQ WILL NOT DO THIS +C +cCALL NEWFM +C +C PRINT MESSAGE EVERYTHING OK +C +c WRITE(6,10) +c10 FORMAT(1X,'CONRAQ TEST SUCCESSFUL, SEE PLOT TO VERIFY', +c 1' PERFORMANCE') +C +C + RETURN +C +C IF ERROR CALL THE PORT ERROR PRINT ROUTINE. +C THIS CALL IS NOT NECESSARY UNLESS YOU ARE IN RECOVER MODE. +C IF YOU ARE NOT IN RECOVER MODE THE ERROR MESSAGE WILL BE PRINTED +C AUTOMATICALLY. +C + 100 CALL EPRIN + RETURN +C + END diff --git a/sys/gio/ncarutil/tests/conras.x b/sys/gio/ncarutil/tests/conras.x new file mode 100644 index 00000000..d2b48dc2 --- /dev/null +++ b/sys/gio/ncarutil/tests/conras.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# T_CONRAS -- test NCAR contour routine CONRAS. + +procedure t_conras () + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tconas (error_code) + if (error_code == 0) + call printf ("Test successful\n") + else + call printf ("Test was not successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () + +end diff --git a/sys/gio/ncarutil/tests/conrast.f b/sys/gio/ncarutil/tests/conrast.f new file mode 100644 index 00000000..c4f3ab12 --- /dev/null +++ b/sys/gio/ncarutil/tests/conrast.f @@ -0,0 +1,147 @@ + SUBROUTINE TCONAS (IERROR) +C +C LATEST REVISION AUGUST 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C CONRAS, THE SUPER ENTRY POINT OF THE +C CONRAN PACKAGE. +C +C USAGE CALL TCONAS (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C .EQ. 0, IF THE TEST WAS SUCCESSFUL, +C .NE. 0, OTHERWISE +C IF NOT ZERO THE NUMBER PRODUCED WILL +C CORRESPOND TO THE ERROR NUMBERS IN +C THE CONRAS LISTING. +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C CONRAS TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR +C PLOT AND TRIANGULATION OF THE DATA ARE PRODUCED +C ON THE DEFAULT GRAPHICS DEVICE UNLESS THE USER +C SPECIFIES OTHERWISE VIA JCL. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY CONRAS +C FILES CONTERP +C CONCOM +C DASHSUPR +C +C SPECIALIST FOR INFORMATION ABOUT THIS ROUTINE OR THE +C ULIB CONRAS PACKAGE, CONTACT THE SPECIALIST +C NAMED IN THE ULIB CONRAS PACKAGE. +C +C LANGUAGE FORTRAN +C +C ALGORITHM A SPARSE DATA SET IS DEFINED VIA DATA +C STATEMENTS. OPTIONS ARE SET TO PRODUCE A +C TITLE AND DISPLAY THE TRIANGULATION GENERATED +C BY THE INTERPOLATING ROUTINES. BY DEFAULT +C A MESSAGE AT THE BOTTEM OF THE PLOT AND A +C PERIMETER ARE ALSO PRODUCED. THIS ROUTINE +C TAKES ADVANTAGE OF THE PORT ERROR HANDLING +C ROUTINES TO DETERMINE IF CONRAS TERMINATED +C NORMALLY. +C +C PORTABILITY ANSI STANDARD +C +C +C SET UP THE SCRATCH SPACES REQUIRED BY CONRAS +C + DIMENSION WK(221),IWK(744),SCR(1600) +C +C SET UP THE ARRAYS TO DEFINE THE DATA SET +C + DIMENSION XD(17),YD(17),ZD(17) + COMMON /RASINT/ IRASMJ, IRASMN, IRASTX +C +C DEFINE THE DATA SET +C + DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8), + 1 XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15), + 2 XD(16),XD(17) + 3 /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20., + 4 5.,15.,10.,7.,13.,16./ +C + DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8), + 1 YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15), + 2 YD(16),YD(17) + 3 /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10., + 4 15.,15.,15.,20.,20.,8./ +C + DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8), + 1 ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15), + 2 ZD(16),ZD(17) + 3 /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1., + 4 1.,1.,1.,1.,1.,25./ +C +C SET UP PARAMETER FOR NUMBER OF INPUT POINTS +C + DATA NDP/17/ +C +C SET PORT ERROR HANDLING ROUTINE TO RECOVERY MODE +C + CALL ENTSR(IROLD,1) +C +C SET UP TITLE FOR PLOT +C + CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAS',29,0) +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C SET OPTION TO DISPLAY THE TRIANGULATION +C + CALL CONOP1('TRI=ON') +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C CALL CONRAS TO CONTOUR DATA +C + CALL CONRAS(XD,YD,ZD,NDP,WK,IWK,SCR) +C +C TEST FOR ERROR +C + IF (NERRO(IERROR).NE.0) GO TO 100 +C +C NO ERROR +C +C +C CALL FRAME, CONRAS WILL NOT DO THIS +C +c CALL NEWFM +C +C PRINT MESSAGE EVERYTHING OK +C +c WRITE(6,10) +c10 FORMAT(1X,'CONRAS TEST SUCCESSFUL, SEE PLOT TO VERIFY ', +c 1'PERFORMANCE') +C +C + RETURN +C +C IF ERROR CALL THE PORT ERROR PRINT ROUTINE. +C THIS CALL IS NOT NECESSARY UNLESS YOU ARE IN RECOVER MODE. +C IF YOU ARE NOT IN RECOVER MODE THE ERROR MESSAGE WILL BE PRINTED +C AUTOMATICALLY. +C + 100 CALL EPRIN + RETURN +C + END diff --git a/sys/gio/ncarutil/tests/conrcqckt.f b/sys/gio/ncarutil/tests/conrcqckt.f new file mode 100644 index 00000000..d9d2f827 --- /dev/null +++ b/sys/gio/ncarutil/tests/conrcqckt.f @@ -0,0 +1,114 @@ + SUBROUTINE TCNQCK (IERROR) +C +C LATEST REVISION JUNE 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C CONRECQCK AND TO TEST CONRECQCK ON A SINGLE +C PROBLEM +C +C USAGE CALL TCNQCK (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C CONRECQCK TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR +C PLOT ARE PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. IN ORDER TO DETERMINE IF THE TEST +C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THESE PLOTS. +C +C PRECISION SINGLE +C +C ALGORITHM THE FUNCTION +C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09) +C -1./((X+.1)**2+Y**2+.09) +C FOR X = -1. TO +1. IN INCREMENTS OF .1 AND +C Y = -1.2 TO +1.2 IN INCREMENTS OF .1 +C IS COMPUTED. +C TCNQCK CALLS SUBROUTINES EZCNTR, CONREC, AND +C PWRIT TO DRAW TWO LABELLED CONTOUR PLOTS OF THE +C ARRAY Z. +C +C PORTABILITY ANSI FORTRAN77 +C +C Z CONTAINS THE VALUES TO BE PLOTTED. +C + REAL Z(21,25) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY +C DEFINE THE CENTER OF THE TITLE STRING. +C + DATA TX/.4267/, TY/.9765/ +C +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 0 +C +C FILL TWO DIMENSIONAL ARRAY TO BE PLOTTED +C + DO 20 I=1,21 + X = .1*FLOAT(I-11) + DO 10 J=1,25 + Y = .1*FLOAT(J-13) + Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)- + 1 1./((X+.10)**2+Y**2+.09) + 10 CONTINUE + 20 CONTINUE +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT (0) +C +C ENTRY EZCNTR REQUIRES ONLY THE ARRAY NAME AND ITS DIMENSIONS +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECQCK +C + CALL WTSTR (TX,TY, + 1 'DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECQCK', + 2 2,0,0) + CALL EZCNTR (Z,21,25) +C +C +C ENTRY CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF DESIRED +C +C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE HIGHEST CONTOUR +C LEVEL (4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS (0.3) ARE +C SPECIFIED. +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECQCK +C + CALL WTSTR (TX,TY, + 1 'DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECQCK', + 2 2,0,0) + CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0) +c CALL NEWFM +C +c WRITE (6,1001) + RETURN +C +c1001 FORMAT (' CONRECQCK TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C +C--------------------------------------------------------------------- +C REVISION HISTORY +C +C JUNE 1984 CONVERTED TO FORTRAN 77 AND GKS +C +C--------------------------------------------------------------------- + END diff --git a/sys/gio/ncarutil/tests/conrcsmtht.f b/sys/gio/ncarutil/tests/conrcsmtht.f new file mode 100644 index 00000000..735d109a --- /dev/null +++ b/sys/gio/ncarutil/tests/conrcsmtht.f @@ -0,0 +1,122 @@ + SUBROUTINE TCNSMT (IERROR) +C +C LATEST REVISION JUNE 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C CONRECSMTH AND TO TEST CONRECSMTH ON A SINGLE +C PROBLEM +C +C USAGE CALL TCNSMT (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C CONRECSMTH TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR +C PLOT ARE PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. IN ORDER TO DETERMINE IF THE TEST +C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THESE PLOTS. +C +C PRECISION SINGLE +C +C +C LANGUAGE FORTRAN +C +C ALGORITHM THE FUNCTION +C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09) +C -1./((X+.1)**2+Y**2+.09) +C FOR X = -1. TO +1. IN INCREMENTS OF .1 AND +C Y = -1.2 TO +1.2 IN INCREMENTS OF .1 +C IS COMPUTED. +C TCNSMT CALLS SUBROUTINES EZCNTR, CONREC, AND +C WTSTR TO DRAW TWO LABELLED CONTOUR PLOTS OF THE +C ARRAY Z. +C +C PORTABILITY ANSI FORTRAN77 STANDARD +C +C +C Z CONTAINS THE VALUES TO BE PLOTTED. +C + REAL Z(21,25) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY +C DEFINE THE CENTER OF THE TITLE STRING. +C +c DATA TX/0.42676/, TY/0.97656/ + TX = 0.42676 + TY = 0.97656 +C +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 0 +C +C FILL TWO DIMENSIONAL ARRAY TO BE PLOTTED +C + DO 20 I=1,21 + X = .1*FLOAT(I-11) + DO 10 J=1,25 + Y = .1*FLOAT(J-13) + Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)- + 1 1./((X+.10)**2+Y**2+.09) + 10 CONTINUE + 20 CONTINUE +C +C SELECT NORMAIZATION TRANS NUMBER TO WRITE TITLES +C + CALL GSELNT (0) +C +C ENTRY EZCNTR REQUIRES ONLY THE ARRAY NAME AND ITS DIMENSIONS +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSMTH +C + CALL WTSTR (TX,TY, + 1 'DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSMTH', + 2 2,0,0) + CALL EZCNTR (Z,21,25) +C +C +C ENTRY CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF DESIRED +C +C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE HIGHEST CONTOUR +C LEVEL (4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS (0.3) ARE +C SPECIFIED. +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSMTH +C + CALL WTSTR (TX,TY, + 1 'DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSMTH', + 2 2,0,0) + CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0) +c CALL NEWFM +C +c WRITE (6,1001) + RETURN +C +c 1001 FORMAT (' CONRECSMTH TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C +C +C--------------------------------------------------------------------- +C +C REVISION HISTORY +C +C JUNE 1984 CONVERTED TO FORTRAN 77 AND GKS +C +C--------------------------------------------------------------------- + END diff --git a/sys/gio/ncarutil/tests/conrcsprt.f b/sys/gio/ncarutil/tests/conrcsprt.f new file mode 100644 index 00000000..484d1ccc --- /dev/null +++ b/sys/gio/ncarutil/tests/conrcsprt.f @@ -0,0 +1,110 @@ + SUBROUTINE TCNSUP (IERROR) +C +C LATEST REVISION JUNE 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C CONRECSUPR AND TO TEST CONRECSUPR ON A SINGLE +C PROBLEM +C +C USAGE CALL TCNSUP (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C CONRECSUPR TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR +C PLOT ARE PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. IN ORDER TO DETERMINE IF THE TEST +C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THESE PLOTS. +C +C PRECISION SINGLE +C +C LANGUAGE FORTRAN +C +C ALGORITHM THE FUNCTION +C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09) +C -1./((X+.1)**2+Y**2+.09) +C FOR X = -1. TO +1. IN INCREMENTS OF .1 AND +C Y = -1.2 TO +1.2 IN INCREMENTS OF .1 +C IS COMPUTED. +C TCNSUP CALLS SUBROUTINES EZCNTR, CONREC, AND +C WTSTR TO DRAW TWO LABELLED CONTOUR PLOTS OF THE +C ARRAY Z. +C +C PORTABILITY ANSI FORTRAN77 +C +C Z CONTAINS THE VALUES TO BE PLOTTED. +C + REAL Z(21,25) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY +C DEFINE THE CENTER OF THE TITLE STRING. +C + DATA TX/0.4219/, TY/0.9765/ +C +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 0 +C +C FILL TWO DIMENSIONAL ARRAY TO BE PLOTTED +C + DO 20 I=1,21 + X = .1*FLOAT(I-11) + DO 10 J=1,25 + Y = .1*FLOAT(J-13) + Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)- + 1 1./((X+.10)**2+Y**2+.09) + 10 CONTINUE + 20 CONTINUE +C +C SELECT NORMALIZATION TRANS NUMBER 0 +C + CALL GSELNT (0) +C +C ENTRY EZCNTR REQUIRES ONLY THE ARRAY NAME AND ITS DIMENSIONS +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSUPR +C + CALL WTSTR (TX,TY, + 1 'DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONRECSUPR', + 2 2,0,0) + CALL EZCNTR (Z,21,25) +C +C +C ENTRY CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF DESIRED +C +C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE HIGHEST CONTOUR +C LEVEL (4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS (0.3) ARE +C SPECIFIED. ALSO THE LABELLING OF THE HIGHS AND LOWS IS SUPRESSED. +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSUPR +C + CALL WTSTR (TX,TY, + 1 'DEMONSTRATION PLOT FOR CONREC ENTRY OF CONRECSUPR', + 2 2,0,0) + CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,-1,0) + CALL NEWFM +C + WRITE (6,1001) + RETURN +C + 1001 FORMAT (' CONRECSUPR TEST SUCCESSFUL',24X, + 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/conrec.x b/sys/gio/ncarutil/tests/conrec.x new file mode 100644 index 00000000..2d9adfe5 --- /dev/null +++ b/sys/gio/ncarutil/tests/conrec.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# T_CONREC -- test NCAR contour routine CONREC. + +procedure t_conrec () + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tconre (2, error_code) + if (error_code == 0) + call printf ("Test successful\n") + else + call printf ("Test was not successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () + +end diff --git a/sys/gio/ncarutil/tests/conrect.f b/sys/gio/ncarutil/tests/conrect.f new file mode 100644 index 00000000..401aad9b --- /dev/null +++ b/sys/gio/ncarutil/tests/conrect.f @@ -0,0 +1,118 @@ + SUBROUTINE TCONRE (nplot, IERROR) +C +C LATEST REVISION JUNE 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C CONREC AND TO TEST CONREC ON A SINGLE +C PROBLEM +C +C USAGE CALL TCONRE (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C CONREC TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR +C PLOT ARE PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. IN ORDER TO DETERMINE IF THE TEST +C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THESE PLOTS. +C +C PRECISION SINGLE +C +C LANGUAGE FORTRAN +C +C ALGORITHM THE FUNCTION +C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09) +C -1./((X+.1)**2+Y**2+.09) +C FOR X = -1. TO +1. IN INCREMENTS OF .1 AND +C Y = -1.2 TO +1.2 IN INCREMENTS OF .1 +C IS COMPUTED. +C TCONRE CALL SUBROUTINES EZCNTR, CONREC, AND +C PWRIT TO DRAW TWO LABELLED CONTOUR PLOTS OF THE +C ARRAY Z. +C +C PORTABILITY FORTRAN77 +C +C +C Z CONTAINS THE VALUES TO BE PLOTTED. +C + REAL Z(21,25) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY +C DEFINE THE CENTER OF THE TITLE STRING. +C +C DATA TX/.3955/, TY/.9765/ + data tx/.4267/, ty/.97/ +C +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 0 +C +C FILL TWO DIMENSIONAL ARRAY TO BE PLOTTED +C + DO 20 I=1,21 + X = .1*FLOAT(I-11) + DO 10 J=1,25 + Y = .1*FLOAT(J-13) + Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)- + 1 1./((X+.10)**2+Y**2+.09) + 10 CONTINUE + 20 CONTINUE +C +C SELECT NORMALIZATION TRANSFORMATION NUMBER 0 +C + CALL GSELNT ( 0 ) +C +C ENTRY EZCNTR REQUIRES ONLY THE ARRAY NAME AND ITS DIMENSIONS +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONREC +C +c +noao: flag added to plot either EZCNTR or CONREC + if (nplot .eq. 1) then + CALL WTSTR ( TX, TY, + 1 'DEMONSTRATION PLOT FOR EZCNTR ENTRY OF CONREC',2,0,0 ) + CALL EZCNTR (Z,21,25) + endif +c -noao +C +C +C ENTRY CONREC ALLOWS USER SPECIFICATION OF PLOT PARAMETERS, IF DESIRED +C +C IN THIS EXAMPLE, THE LOWEST CONTOUR LEVEL (-4.5), THE HIGHEST CONTOUR +C LEVEL (4.5), AND THE INCREMENT BETWEEN CONTOUR LEVELS (0.3) ARE +C SPECIFIED. +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR CONREC ENTRY OF CONREC +C +c +noao: flag added to plot either EZCNTR of CONREC + if (nplot .eq. 2) then + CALL WTSTR ( TX ,TY, + 1 'DEMONSTRATION PLOT FOR CONREC ENTRY OF CONREC',2,0,0 ) + CALL CONREC (Z,21,21,25,-4.5,4.5,.3,0,0,0) + endif +c -noao +c CALL NEWFM +C +C WRITE (6,1001) + RETURN +C +C1001 FORMAT (' CONREC TEST SUCCESSFUL',24X, +C 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/dashchar.x b/sys/gio/ncarutil/tests/dashchar.x new file mode 100644 index 00000000..77430f37 --- /dev/null +++ b/sys/gio/ncarutil/tests/dashchar.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +# Test NCAR routine DASHCHAR + +procedure t_dashchar() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tdashc (error_code) + + if (error_code == 0) + call printf ("Test successful\n") + else + call printf ("Test was not successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/dashchart.f b/sys/gio/ncarutil/tests/dashchart.f new file mode 100644 index 00000000..fa583b84 --- /dev/null +++ b/sys/gio/ncarutil/tests/dashchart.f @@ -0,0 +1,145 @@ + SUBROUTINE TDASHC (IERROR) +C +C LATEST REVISION MAY 1984 +C +C PURPOSE TO PROVIDE A DEMONSTRATION OF DASHCHAR +C AND TO TEST DASHCHAR ON A SIMPLE PROBLEM +C +C USAGE CALL TDASHC (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST IS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C DASHCHAR TEST SUCCESSFUL . . . SEE PLOT +C TO VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C +C IN ADDITION, ONE FRAME CONTAINING THE +C DASHED LINE PLOT IS PRODUCED ON THE +C MACHINE GRAPHICS DEVICE. TO DETERMINE +C IF THE TEST IS SUCCESSFUL, IT IS NECESSARY +C TO EXAMINE THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY DASHCHAR +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM TDASHC UTILIZES THE SOFTWARE DASHCHAR +C SUBROUTINES DASHDB, DASHDC, FRSTD, VECTD, +C LINED AND CURVED TO DRAW FIVE CURVES ON ONE +C PICTURE USING FIVE DIFFERENT DASHCHAR +C PATTERNS. EACH CURVE IS CENTERED ABOUT +C SOLID AXIS LINES AND LABELLED WITH THE +C CHARACTER REPRESENTATION OF THE DASHCHAR +C PATTERN USED. +C +C PORTABILITY FORTRAN 77 +C +C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS +C ORDINATE VALUES OF THE CURVE TO BE PLOTTED. +C + DIMENSION X(31) ,Y(31) +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT(0) +C +C SET SOLID DASH PATTERN, 1111111111111111 (BINARY). +C BOOLEAN OPERATIONS (EMPLOYING LOCALLY-IMPLEMENTED SUPPORT +C ROUTINES) ARE USED FOR PORTABILITY TO HOSTS WITH 16 BIT +C INTEGERS. +C + ISOLID = IOR (ISHIFT (32767,1), 1) +C + DO 130 K=1,5 + CALL DASHDB (ISOLID) + ORG =1.07-0.195*K +C +C DRAW CENTRAL AXIS FOR EACH CURVE +C + CALL FRSTD (.50,ORG-0.03) + CALL VECTD (.50,ORG+0.03) + CALL LINED (.109,ORG,.891,ORG) +C +C CALL SUBROUTINE DASHDC WITH A DIFFERENT DASHED LINE AND CHARACTER +C COMBINATION FOR EACH OF FIVE CURVES +C + GO TO ( 10, 20, 30, 40, 50),K + 10 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12) + GO TO 60 + 20 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12) + GO TO 60 + 30 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12) + GO TO 60 + 40 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12) + GO TO 60 + 50 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12) + 60 CONTINUE +C +C COMPUTE VALUES FOR AND DRAW THE KTH CURVE +C + DO 70 I=1,31 + THETA = FLOAT(I-1)*3.1415926535897932/15. + X(I) = 0.5+.4*COS(THETA) + Y(I) = ORG+.075*SIN(FLOAT(K)*THETA) + 70 CONTINUE + CALL CURVED (X,Y,31) +C +C LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER REPRESENTATION +C OF THE DASHCHAR PATTERN. IN THE PATTERN LABELS, A AND D +C SHOULD BE INTERPRETED AS APOSTROPHE AND DOLLAR SIGN. +C +C SET TEXT ALIGNMENT TO CENTER THE STRING AT THE LEFT OF THE +C STRING AND IN THE VERTICAL CENTER +C + CALL GSTXAL(1,3) +C +C SET CHARACTER HEIGHT +C + CALL GSCHH(.012) +C + ORY = ORG+.089 + GO TO ( 80, 90,100,110,120),K + 80 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1') + GO TO 130 + 90 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2') + GO TO 130 + 100 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3') + GO TO 130 + 110 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4') + GO TO 130 + 120 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5') +C + 130 CONTINUE +C + CALL GSTXAL(2,3) + CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR DASHCHAR') + CALL GTX (.5,.015,'IN IPAT STRINGS, A AND D SHOULD BE INTERPRETED + 1AS APOSTROPHE AND DOLLAR SIGN') +C +C ADVANCE FRAME +C +c + noao: no need for clearing terminal +c CALL NEWFM +c - noao +C + IERROR = 0 +C WRITE (6,1001) +C + RETURN +C +C +C1001 FORMAT (' DASHCHAR TEST SUCCESSFUL',24X, +C 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/dashlinet.f b/sys/gio/ncarutil/tests/dashlinet.f new file mode 100644 index 00000000..c857428c --- /dev/null +++ b/sys/gio/ncarutil/tests/dashlinet.f @@ -0,0 +1,138 @@ + SUBROUTINE TDASHL (IERROR) +C +C LATEST REVISION APRIL 1984 +C +C PURPOSE TO PROVIDE A DEMONSTRATION OF DASHLINE +C AND TO TEST DASHLINE ON A SIMPLE PROBLEM +C +C USAGE CALL TDASHL (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST IS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C DASHLINE TEST SUCCESSFUL . . . SEE PLOT +C TO VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C +C IN ADDITION, ONE FRAME CONTAINING THE +C DASHED LINE PLOT IS PRODUCED ON THE +C MACHINE GRAPHICS DEVICE. TO DETERMINE +C IF THE TEST IS SUCCESSFUL, IT IS NECESSARY +C TO EXAMINE THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY DASHLINE +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM TDASHL UTILIZES THE SOFTWARE DASHLINE +C SUBROUTINES DASHDB, FRSTD, VECTD, LINED AND +C CURVED TO DRAW FIVE CURVES ON ONE PICTURE +C USING FIVE DIFFERENT DASHLINE PATTERNS. EACH +C CURVE IS CENTERED ABOUT SOLID AXIS LINES AND +C LABELLED WITH THE BINARY REPRESENTATION OF THE +C DASHLINE PATTERN USED. +C +C PORTABILITY FORTRAN 77 +C +C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS +C COORDINATE VALUES OF THE CURVE TO BE PLOTTED. +C + DIMENSION X(31) ,Y(31) ,IPAT(5) +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT(0) +C +C SET SOLID DASH PATTERN, 1111111111111111 (BINARY). +C BOOLEAN OPERATIONS (EMPLOYING LOCALLY IMPLEMENTED +C SUPPORT ROUTINES) ARE USED. +C + ISOLID = IOR (ISHIFT (32767,1), 1) +C +C ARRAY IPAT CONTAINS 5 DIFFERENT 16-BIT DASH PATTERNS. THE PATTERNS +C CONSTRUCTED WITH BOOLEAN OPERATIONS AS ABOVE. +C THE BINARY REPRESENTATIONS OF THE PATTERNS ARE +C 0001110001111111 +C 1111000011110000 +C 1111110011111100 +C 1111111100000000 +C 1111111111111100 +C + IPAT(1) = IOR (ISHIFT ( 3647,1), 1) + IPAT(2) = ISHIFT (30840,1) + IPAT(3) = ISHIFT (32382,1) + IPAT(4) = ISHIFT (32640,1) + IPAT(5) = ISHIFT (32766,1) +C + DO 70 K=1,5 + CALL DASHDB (ISOLID) + ORG =1.07-0.195*K +C +C DRAW CENTRAL AXIS FOR EACH CURVE +C + CALL FRSTD (.50,ORG-0.03) + CALL VECTD (.50,ORG+0.03) + CALL LINED (.109,ORG,.891,ORG) + CALL DASHDB (IPAT(K)) +C +C COMPUTE VALUES FOR AND DRAW THE KTH CURVE +C + DO 10 I=1,31 + THETA = FLOAT(I-1)*3.1415926535897932/15. + X(I) = 0.5+.4*COS(THETA) + Y(I) = ORG+.075*SIN(FLOAT(K)*THETA) + 10 CONTINUE + CALL CURVED (X,Y,31) +C +C LABEL EACH CURVE WITH THE APPROPRIATE BINARY REPRESENTATION OF +C THE DASHLINE PATTERN +C +C SET TEXT ALIGNMENT TO CENTER THE STRING AT THE LEFT OF THE +C STRING AND IN THE VERTICAL CENTER +C + CALL GSTXAL(1,3) +C +C SET CHARACTER HEIGHT +C + CALL GSCHH(.012) +C + ORY = ORG+.09 + GO TO ( 20, 30, 40, 50, 60),K + 20 CALL GTX (.1,ORY,'IPAT=0001110001111111') + GO TO 70 + 30 CALL GTX (.1,ORY,'IPAT=1111000011110000') + GO TO 70 + 40 CALL GTX (.1,ORY,'IPAT=1111110011111100') + GO TO 70 + 50 CALL GTX (.1,ORY,'IPAT=1111111100000000') + GO TO 70 + 60 CALL GTX (.1,ORY,'IPAT=1111111111111100') +C + 70 CONTINUE +C + CALL GSTXAL(2,3) + CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR DASHLINE') +C +C ADVANCE FRAME +C + CALL NEWFM +C + IERROR = 0 + WRITE (6,1001) +C + RETURN +C + 1001 FORMAT (' DASHLINE TEST SUCCESSFUL',24X, + 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/dashsmth.x b/sys/gio/ncarutil/tests/dashsmth.x new file mode 100644 index 00000000..4bca9807 --- /dev/null +++ b/sys/gio/ncarutil/tests/dashsmth.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +# Test NCAR routine DASHSMTH + +procedure t_dashsmth() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tdashs (error_code) + + if (error_code == 0) + call printf ("Test successful\n") + else + call printf ("Test was not successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/dashsmtht.f b/sys/gio/ncarutil/tests/dashsmtht.f new file mode 100644 index 00000000..147d5139 --- /dev/null +++ b/sys/gio/ncarutil/tests/dashsmtht.f @@ -0,0 +1,144 @@ + SUBROUTINE TDASHS (IERROR) +C +C LATEST REVISION JUNE 1984 +C +C PURPOSE TO PROVIDE A DEMONSTRATION OF DASHSMTH +C AND TO TEST DASHSMTH ON A SIMPLE PROBLEM +C +C USAGE CALL TDASHS (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST IS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C DASHSMTH TEST SUCCESSFUL . . . SEE PLOT +C TO VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C +C IN ADDITION, ONE FRAME CONTAINING THE +C DASHED LINE PLOT IS PRODUCED ON THE +C MACHINE GRAPHICS DEVICE. TO DETERMINE +C IF THE TEST IS SUCCESSFUL, IT IS NECESSARY +C TO EXAMINE THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY DASHSMTH +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM TDASHS UTILIZES THE SOFTWARE DASHSMTH +C SUBROUTINES DASHDB, DASHDC, FRSTD, +C VECTD, LASTD, LINED AND CURVED TO +C DRAW FIVE CURVES ON ONE PICTURE USING +C FIVE DIFFERENT DASHSMTH PATTERNS. EACH +C CURVE IS CENTERED ABOUT SOLID AXIS LINES AND +C LABELLED WITH THE CHARACTER REPRESENTATION OF +C THE DASHSMTH PATTERN USED. +C +C PORTABILITY FORTRAN 77 +C +C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS +C ORDINATE VALUES OF THE CURVE TO BE PLOTTED. +C + DIMENSION X(31) ,Y(31) +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT(0) +C +C SET SOLID DASH PATTERN, 1111111111111111 (BINARY). +C BOOLEAN OPERATIONS (EMPLOYING LOCALLY IMPLEMENTED SUPPORT +C ROUTINES) ARE USED FOR PORTABILITY TO HOSTS WITH 16 BIT +C INTEGERS. +C + ISOLID = IOR (ISHIFT (32767,1), 1) +C + DO 130 K=1,5 + CALL DASHDB (ISOLID) + ORG =1.07-0.195*K +C +C DRAW CENTRAL AXIS FOR EACH CURVE +C + CALL FRSTD (.50,ORG-0.03) + CALL VECTD (.50,ORG+0.03) + CALL LASTD + CALL LINED (.109,ORG,.891,ORG) +C +C CALL SUBROUTINE DASHDC WITH A DIFFERENT DASHED LINE AND CHARACTER +C COMBINATION FOR EACH OF FIVE CURVES +C + GO TO ( 10, 20, 30, 40, 50),K + 10 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12) + GO TO 60 + 20 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12) + GO TO 60 + 30 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12) + GO TO 60 + 40 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12) + GO TO 60 + 50 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12) + 60 CONTINUE +C +C COMPUTE VALUES FOR AND DRAW THE KTH CURVE +C + DO 70 I=1,31 + THETA = FLOAT(I-1)*3.1415926535897932/15. + X(I) = 0.5+.4*COS(THETA) + Y(I) = ORG+.075*SIN(FLOAT(K)*THETA) + 70 CONTINUE + CALL CURVED (X,Y,31) +C +C LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER REPRESENTATION +C OF THE DASHSMTH PATTERN. IN THE PATTERN LABELS, A AND D +C SHOULD BE INTERPRETED AS APOSTROPHE AND DOLLAR SIGN. +C +C +C SET TEXT ALIGNMENT TO CENTER THE STRING AT THE LEFT OF THE +C STRING AND IN THE VERTICAL CENTER +C + CALL GSTXAL(1,3) +C +C SET CHARACTER HEIGHT +C + CALL GSCHH(.012) +C + ORY = ORG+.089 + GO TO ( 80, 90,100,110,120),K + 80 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1') + GO TO 130 + 90 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2') + GO TO 130 + 100 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3') + GO TO 130 + 110 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4') + GO TO 130 + 120 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5') +C + 130 CONTINUE +C + CALL GSTXAL(2,3) + CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR DASHSMTH') + CALL GTX (.5,.015,'IN IPAT STRINGS, A AND D SHOULD BE INTERPRETED + 1AS APOSTROPHE AND DOLLAR SIGN') +C +C ADVANCE FRAME +C +c CALL NEWFM +C + IERROR = 0 +c WRITE (6,1001) +C + RETURN +C +c 1001 FORMAT (' DASHSMTH TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/dashsuprt.f b/sys/gio/ncarutil/tests/dashsuprt.f new file mode 100644 index 00000000..f35c9c8b --- /dev/null +++ b/sys/gio/ncarutil/tests/dashsuprt.f @@ -0,0 +1,151 @@ + SUBROUTINE TDASHP (IERROR) +C +C LATEST REVISION JUNE 1984 +C +C PURPOSE TO PROVIDE A DEMONSTRATION OF DASHSUPR +C AND TO TEST DASHSUPR ON A SIMPLE PROBLEM +C +C USAGE CALL TDASHP (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST IS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C DASHSUPR TEST SUCCESSFUL . . . SEE PLOT +C TO VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C +C IN ADDITION, ONE FRAME CONTAINING THE +C DASHED LINE PLOT IS PRODUCED ON THE +C MACHINE GRAPHICS DEVICE. TO DETERMINE +C IF THE TEST IS SUCCESSFUL, IT IS NECESSARY +C TO EXAMINE THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY DASHSUPR +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM TDASHP UTILIZES THE SOFTWARE DASHSUPR +C SUBROUTINES DASHDB, DASHDC, FRSTD, +C VECTD, LASTD, LINED AND CURVED TO +C DRAW FIVE CURVES ON ONE PICTURE USING +C FIVE DIFFERENT DASHSMTH PATTERNS. EACH +C CURVE IS CENTERED ABOUT SOLID AXIS LINES AND +C LABELLED WITH THE CHARACTER REPRESENTATION OF +C THE DASHSUPR PATTERN USED. +C +C PORTABILITY FORTRAN 77 +C +C X CONTAINS ABSCISSAE VALUES OF THE CURVE TO BE PLOTTED, Y CONTAINS +C ORDINATE VALUES OF THE CURVE TO BE PLOTTED. +C + DIMENSION X(31) ,Y(31) +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT(0) +C +C RESET INITIALIZES THE MODEL PICTURE ARRAY AND SHOULD BE CALLED WITH +C EACH NEW FRAME AND BEFORE THE OTHER SUBROUTINES OF THE DASHSUPR +C PACKAGE. +C + CALL RESET +C +C +C SET SOLID DASH PATTERN, 1111111111111111 (BINARY). +C BOOLEAN OPERATIONS (EMPLOYING LOCALLY IMPLEMENTED PLOT PACKAGE +C SUPPORT ROUTINES) ARE USED FOR PORTABILITY TO HOSTS WITH 16 BIT +C INTEGERS. +C + ISOLID = IOR (ISHIFT (32767,1), 1) +C + DO 130 K=1,5 + CALL DASHDB (ISOLID) + ORG =1.07-0.195*K +C +C DRAW CENTRAL AXIS FOR EACH CURVE +C + CALL FRSTD (.50,ORG-0.03) + CALL VECTD (.50,ORG+0.03) + CALL LASTD + CALL LINED (.109,ORG,.891,ORG) +C +C CALL SUBROUTINE DASHDC WITH A DIFFERENT DASHED LINE AND CHARACTER +C COMBINATION FOR EACH OF FIVE CURVES +C + GO TO ( 10, 20, 30, 40, 50),K + 10 CALL DASHDC ('$''$''$''$''$''$''$''$K = 1',10,12) + GO TO 60 + 20 CALL DASHDC ('$$$$$$''$''$$$$$$K = 2',10,12) + GO TO 60 + 30 CALL DASHDC ('$$$$''$$$$''$$$$''K = 3',10,12) + GO TO 60 + 40 CALL DASHDC ('$$$$$''''''''''$$$$$K = 4',10,12) + GO TO 60 + 50 CALL DASHDC ('$$$''$$$''$$$''$$$K = 5',10,12) + 60 CONTINUE +C +C COMPUTE VALUES FOR AND DRAW THE KTH CURVE +C + DO 70 I=1,31 + THETA = FLOAT(I-1)*3.1415926535897932/15. + X(I) = 0.5+.4*COS(THETA) + Y(I) = ORG+.075*SIN(FLOAT(K)*THETA) + 70 CONTINUE + CALL CURVED (X,Y,31) +C +C LABEL EACH CURVE WITH THE APPROPRIATE CHARACTER REPRESENTATION +C OF THE DASHSMTH PATTERN. IN THE PATTERN LABELS, A AND D +C SHOULD BE INTERPRETED AS APOSTROPHE AND DOLLAR SIGN. +C +C +C SET TEXT ALIGNMENT TO CENTER THE STRING AT THE LEFT OF THE +C STRING AND IN THE VERTICAL CENTER +C + CALL GSTXAL(1,3) +C +C SET CHARACTER HEIGHT +C + CALL GSCHH(.012) +C + ORY = ORG+.089 + GO TO ( 80, 90,100,110,120),K + 80 CALL GTX(.1,ORY,'IPAT=DADADADADADADADK=1') + GO TO 130 + 90 CALL GTX(.1,ORY,'IPAT=DDDDDDADADDDDDDK=2') + GO TO 130 + 100 CALL GTX(.1,ORY,'IPAT=DDDDADDDDADDDDAK=3') + GO TO 130 + 110 CALL GTX(.1,ORY,'IPAT=DDDDDAAAAADDDDDK=4') + GO TO 130 + 120 CALL GTX(.1,ORY,'IPAT=DDDADDDADDDADDDK=5') +C + 130 CONTINUE +C + CALL GSTXAL(2,3) + CALL GTX (.5,.991,'DEMONSTRATION PLOT FOR DASHSUPR') + CALL GTX (.5,.013,'IN IPAT STRINGS, A AND D SHOULD BE INTERPRETED + 1AS APOSTROPHE AND DOLLAR SIGN') +C +C ADVANCE FRAME +C + CALL NEWFM +C + IERROR = 0 + WRITE (6,1001) +C + RETURN +C + 1001 FORMAT (' DASHSUPR TEST SUCCESSFUL',24X, + 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/ezconrec.x b/sys/gio/ncarutil/tests/ezconrec.x new file mode 100644 index 00000000..afb0775c --- /dev/null +++ b/sys/gio/ncarutil/tests/ezconrec.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# T_EZCONREC -- test NCAR contour routine EZCNTR. + +procedure t_ezconrec () + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tconre (1, error_code) + if (error_code == 0) + call printf ("Test successful\n") + else + call printf ("Test was not successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () + +end diff --git a/sys/gio/ncarutil/tests/ezhafton.x b/sys/gio/ncarutil/tests/ezhafton.x new file mode 100644 index 00000000..e1cbbc2c --- /dev/null +++ b/sys/gio/ncarutil/tests/ezhafton.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +procedure t_ezhafton + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call zhafto (error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/ezhaftont.f b/sys/gio/ncarutil/tests/ezhaftont.f new file mode 100644 index 00000000..b3fcee3b --- /dev/null +++ b/sys/gio/ncarutil/tests/ezhaftont.f @@ -0,0 +1,123 @@ + SUBROUTINE ZHAFTO (IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C EZHAFTON AND TO TEST HAFTON ON A SINGLE +C PROBLEM +C +C USAGE CALL ZHAFTO (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C HAFTON TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE +C HALF-TONE PLOT ARE PRODUCED ON THE MACHINE +C GRAPHICS DEVICE. IN ORDER TO DETERMINE IF THE +C TEST WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THESE PLOTS. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY HAFTON +C FILES +C +C LANGUAGE ANSI FORTRAN 77 +C +C ALGORITHM THE FUNCTION +C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09) +C -1./((X+.1)**2+Y**2+.09) +C FOR X = -1. TO +1. IN INCREMENTS OF .1 AND +C Y = -1.2 TO +1.2 IN INCREMENTS OF .1 +C IS COMPUTED. +C THAFTO CALLS SUBROUTINES EZHFTN AND HAFTON TO +C DRAW TWO HALF-TONE PLOTS OF THE ARRAY Z. +C +C PORTABILITY ANSI STANDARD +C +C +C Z CONTAINS THE VALUES TO BE PLOTTED. +C +C + REAL Z(21,25) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY +C DEFINE THE CENTER OF THE LEFT EDGE OF THE TITLE STRING. +C + DATA TX/0.0762/, TY/0.9769/ +C +C SPECIFY SOME ARGUMENT VALUES FOR ROUTINE HAFTON. +C FLO CONTAINS THE LOW VALUE DESIGNATION FOR HAFTON, FHI +C CONTAINS THE HIGH VALUE DESIGNATION FOR HAFTON, NLEV +C SPECIFIES THE NUMBER OF UNIQUE LEVELS BETWEEN FLO AND FHI, THE +C ABSOLUTE VALUE OF NOPT DETERMINES THE MAPPING OF Z ONTO THE +C INTENSITIES, AND THE SIGN OF NOPT CONTROLS THE DIRECTNESS OR +C INVERSNESS OF THE MAPPING. +C + DATA FLO/-4.0/, FHI/4.0/, NLEV/8/, NOPT/-3/ +C +C + SAVE +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 0 +C +C FILL TWO DIMENSIONAL ARRAY TO BE PLOTTED +C + DO 20 I=1,21 + X = .1*FLOAT(I-11) + DO 10 J=1,25 + Y = .1*FLOAT(J-13) + Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)- + 1 1./((X+.10)**2+Y**2+.09) + 10 CONTINUE + 20 CONTINUE +C +C SELECT NORMALIZATION TRANS 0 FOR PLOTTING TITLE +C + CALL GSELNT (0) +C +C +C +C ENTRY EZHFTN REQUIRES ONLY THE ARRAY NAME AND ITS DIMENSIONS +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON +C + CALL WTSTR (TX,TY, + 1 'DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON',2,0,-1) + CALL EZHFTN (Z,21,25) +C +C ENTRY HAFTON ALLOWS USER SPECIFICATIONS OF PLOT PARAMETERS, IF DESIRED +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON +C +c CALL GSELNT (0) +c CALL WTSTR (TX,TY, +c 1 'DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON',2,0,-1) +c CALL HAFTON (Z,21,21,25,FLO,FHI,NLEV,NOPT,0,0,0.) +c CALL NEWFM +C +c WRITE (6,1001) + RETURN +C +C +c1001 FORMAT (' HAFTON TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/ezisosrf.x b/sys/gio/ncarutil/tests/ezisosrf.x new file mode 100644 index 00000000..21257526 --- /dev/null +++ b/sys/gio/ncarutil/tests/ezisosrf.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routine EZISOSRF + +procedure t_ezisos() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tisosr (1, error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/ezmapg.x b/sys/gio/ncarutil/tests/ezmapg.x new file mode 100644 index 00000000..d2f7dce1 --- /dev/null +++ b/sys/gio/ncarutil/tests/ezmapg.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routine SUPMAP of the EZMAPG utility. + +procedure t_ezmapg() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tsupma (error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/ezmapgt.f b/sys/gio/ncarutil/tests/ezmapgt.f new file mode 100644 index 00000000..fab53ce0 --- /dev/null +++ b/sys/gio/ncarutil/tests/ezmapgt.f @@ -0,0 +1,318 @@ + SUBROUTINE TSUPMA (IERROR) +C +C LATEST REVISION AUGUST 1984 +C +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF THE +C SUPMAP AND MAPDRW ENTRYS OF EZMAPG. +C +C USAGE CALL TSUPMA (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0 IF THE TEST WAS SUCCESSFUL +C = 1 OTHERWISE +C +C I/O IF EACH CALL TO ROUTINE SUPMAP RESULTS IN +C A NORMAL SUPMAP EXIT, THE MESSAGE +C SUPMAP TEST SUCCESSFUL . . SEE PLOT TO +C VERIFY PERFORMANCE +C IS PRINTED ON UNIT 6. +C +C TEN CONTINENTAL OUTLINE PLOTS, EACH +C RESULTING FROM A DIFFERENT SPECIFIED +C PROJECTION, ARE PRODUCED ON THE MACHINE +C GRAPHICS DEVICE. +C TO DETERMINE IF THE TEST WAS SUCCESSFUL, +C IT IS NECESSARY TO EXAMINE THESE PLOTS. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY EZMAPG +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM SUBROUTINE TSUPMA CALLS ROUTINE SUPMAP ONCE +C FOR EACH OF THE NINE PROJECTION TYPES +C IN SUPMAP. SPECIFICALLY, THESE ARE +C STEREOGRAPHIC +C ORTHOGRAPHIC +C LAMBERT CONFORMAL CONIC WITH TWO +C STANDARD PARALLELS +C LAMBERT EQUAL AREA +C GNOMONIC +C AZIMUTHAL EQUIDISTANT +C CYLINDRICAL EQUIDISTANT +C MERCATOR +C MOLLWEIDE TYPE +C THE ROUTINE THEN DEMONSTRATES THE SATELLITE VIEW +C PROJECTION. +C +C HISTORY WRITTEN OCTOBER, 1976 +C +C PORTABILITY ANSI FORTRAN 77 +C +C +C COMMON BLOCK FOR SATELLITE VIEW PROJECTION +C + COMMON /SATMAP/ SL +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT PLOTTER GRID +C WHERE THE COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX +C AND TY DEFINE THE CENTER OF THE TITLE STRING. +C + DATA TX/0.5/, TY/0.9765/ +C +C INITIALIZE ERROR FLAG +C + IERROR = 0 +C +C CHECK PERFORMANCE CRITERION +C SPECIFY PARAMETERS BEFORE EACH SUPMAP CALL +C + IPROJ = 1 + POLAT = 80. + POLONG = -160. + ROT = 0. + PL1 = 0. + PL2 = 0. + PL3 = 0. + PL4 = 0. + JLTS = 1 + JGRID = 10 + IUSOUT = -1 + IDOT = 0 +C +C SELECT NORMALIZATION TRANS 0 TO WRITE TITLE +C + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: STEREOGRAPHIC PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c CALL NEWFM + IF (IER .EQ. 0) GO TO 10 +C +C SUPMAP TEST UNSUCCESSFUL +C +c WRITE (6,1001) IPROJ + IERROR = 1 + 10 CONTINUE +C +C + IPROJ = 2 + POLAT = 60. + POLONG = -120. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: ORTHOGRAPHIC PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c +noao: frame advance handled by calling routine +c CALL NEWFM +c -noao + IF (IER .EQ. 0) GO TO 20 +C +C SUPMAP TEST UNSUCCESSFUL +C +c WRITE (6,1001) IPROJ + IERROR = 1 + 20 CONTINUE +C +C + IPROJ = -3 + POLAT = 45. + POLONG = -100. + ROT = 45. + PL1 = 50. + PL2 = -130. + PL3 = 20. + PL4 = -75. + JLTS = 2 + JGRID = 10 + IUSOUT = 1 + IDOT = 0 + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: LAMBERT CONFORMAL CONIC PROJECTION' + 2 ,2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c +noao: frame advance is handled by calling routine +c CALL NEWFM +c -noao + IF (IER .EQ. 0) GO TO 30 +C +C SUPMAP TEST UNSUCCESSFUL +C +c WRITE (6,1001) IPROJ + IERROR = 1 + 30 CONTINUE +C +C + IPROJ = 4 + POLAT = 20. + POLONG = -40. + ROT = 0. + PL1 = 0. + PL2 = 0. + PL3 = 0. + PL4 = 0. + JLTS = 1 + JGRID = 10 + IUSOUT = -1 + IDOT = 0 + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: LAMBERT EQUAL AREA PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c +noao: frame advance is handled by calling routine +c CALL NEWFM +c -nooa + IF (IER .EQ. 0) GO TO 40 +C +C SUPMAP TEST UNSUCCESSFUL +C +C WRITE (6,1001) IPROJ + IERROR = 1 + 40 CONTINUE +C +C + IPROJ = 5 + POLAT = 0. + POLONG = 0. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: GNOMONIC PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c +noao: frame advance handled by calling routine +c CALL NEWFM +c -noao + IF (IER .EQ. 0) GO TO 50 +C +C SUPMAP TEST UNSUCCESSFUL +C +c WRITE (6,1001) IPROJ + IERROR = 1 + 50 CONTINUE +C +C + IPROJ = 6 + POLAT = -20. + POLONG = 40. + JGRID = 5 + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: AZIMUTHAL EQUIDISTANT PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c +noao: frame advance handled by calling routine +c CALL NEWFM +c -noao + IF (IER .EQ. 0) GO TO 60 +C +C SUPMAP TEST UNSUCCESSFUL +C +c WRITE (6,1001) IPROJ + IERROR = 1 + 60 CONTINUE +C +C + IPROJ = 8 + POLAT = -40. + POLONG = 80. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: CYLINDRICAL EQUIDISTANT PROJECTION' + 2 ,2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c +noao: frame advance handled by calling routine +c CALL NEWFM +c -noao + IF (IER .EQ. 0) GO TO 70 +C +C SUPMAP TEST UNSUCCESSFUL +C +c WRITE (6,1001) IPROJ + IERROR = 1 + 70 CONTINUE +C +C + IPROJ = 9 + POLAT = -60. + POLONG = 120. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: MERCATOR PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c +noao: frame advance handled by calling routine +c CALL NEWFM +c -noao + IF (IER .EQ. 0) GO TO 80 +C +C SUPMAP TEST UNSUCCESSFUL +C +c WRITE (6,1001) IPROJ + IERROR = 1 + 80 CONTINUE +C +C + IPROJ = 10 + POLAT = -80. + POLONG = 160. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: MOLLWEIDE TYPE PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) +c +noao: frame advance handled by calling routine +c CALL NEWFM +c -noao + IF (IER .EQ. 0) GO TO 90 +C +C SUPMAP TEST UNSUCCESSFUL +C +c WRITE (6,1001) IPROJ + IERROR = 1 + 90 CONTINUE +C +C DEMONSTRATION OF SATELLITE VIEW PROJECTION +C + SL = 6.5 + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'EZMAPG DEMONSTRATION: SATELLITE VIEW PROJECTION', + 2 2,0,0) + CALL MAPROJ('OR',0.0,-135.0,0.0) + CALL MAPSET('MA',0.0,0.0,0.0,0.0) + CALL MAPDRW +c +noao: frame advance handled by calling routine +c CALL NEWFM +c -noao +C +C +c IF (IERROR .EQ. 0) WRITE (6,1002) +c IF (IERROR .EQ. 1) WRITE (6,1003) + RETURN +C +C +c1001 FORMAT (' SUPMAP RETURNED ERROR FLAG',' IPROJ=',I4/) +c1002 FORMAT(' SUPMAP TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +c1003 FORMAT (' SUPMAP TEST UNSUCCESSFUL') +C + END diff --git a/sys/gio/ncarutil/tests/ezmapt.f b/sys/gio/ncarutil/tests/ezmapt.f new file mode 100644 index 00000000..330fe6e2 --- /dev/null +++ b/sys/gio/ncarutil/tests/ezmapt.f @@ -0,0 +1,300 @@ + SUBROUTINE TSUPMA (IERROR) +C +C LATEST REVISION AUGUST 1984 +C +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF THE +C SUPMAP AND MAPDRW ENTRYS OF EZMAPG. +C +C USAGE CALL TSUPMA (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0 IF THE TEST WAS SUCCESSFUL +C = 1 OTHERWISE +C +C I/O IF EACH CALL TO ROUTINE SUPMAP RESULTS IN +C A NORMAL SUPMAP EXIT, THE MESSAGE +C SUPMAP TEST SUCCESSFUL . . SEE PLOT TO +C VERIFY PERFORMANCE +C IS PRINTED ON UNIT 6. +C +C TEN CONTINENTAL OUTLINE PLOTS, EACH +C RESULTING FROM A DIFFERENT SPECIFIED +C PROJECTION, ARE PRODUCED ON THE MACHINE +C GRAPHICS DEVICE. +C TO DETERMINE IF THE TEST WAS SUCCESSFUL, +C IT IS NECESSARY TO EXAMINE THESE PLOTS. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY EZMAPG +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM SUBROUTINE TSUPMA CALLS ROUTINE SUPMAP ONCE +C FOR EACH OF THE NINE PROJECTION TYPES +C IN SUPMAP. SPECIFICALLY, THESE ARE +C STEREOGRAPHIC +C ORTHOGRAPHIC +C LAMBERT CONFORMAL CONIC WITH TWO +C STANDARD PARALLELS +C LAMBERT EQUAL AREA +C GNOMONIC +C AZIMUTHAL EQUIDISTANT +C CYLINDRICAL EQUIDISTANT +C MERCATOR +C MOLLWEIDE TYPE +C THE ROUTINE THEN DEMONSTRATES THE SATELLITE VIEW +C PROJECTION. +C +C HISTORY WRITTEN OCTOBER, 1976 +C +C PORTABILITY ANSI FORTRAN 77 +C +C +C COMMON BLOCK FOR SATELLITE VIEW PROJECTION +C + COMMON /SATMAP/ SL +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT PLOTTER GRID +C WHERE THE COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX +C AND TY DEFINE THE CENTER OF THE TITLE STRING. +C + DATA TX/0.5/, TY/0.9765/ +C +C INITIALIZE ERROR FLAG +C + IERROR = 0 +C +C CHECK PERFORMANCE CRITERION +C SPECIFY PARAMETERS BEFORE EACH SUPMAP CALL +C + IPROJ = 1 + POLAT = 80. + POLONG = -160. + ROT = 0. + PL1 = 0. + PL2 = 0. + PL3 = 0. + PL4 = 0. + JLTS = 1 + JGRID = 10 + IUSOUT = -1 + IDOT = 0 +C +C SELECT NORMALIZATION TRANS 0 TO WRITE TITLE +C + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: STEREOGRAPHIC PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 10 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 10 CONTINUE +C +C + IPROJ = 2 + POLAT = 60. + POLONG = -120. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: ORTHOGRAPHIC PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 20 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 20 CONTINUE +C +C + IPROJ = -3 + POLAT = 45. + POLONG = -100. + ROT = 45. + PL1 = 50. + PL2 = -130. + PL3 = 20. + PL4 = -75. + JLTS = 2 + JGRID = 10 + IUSOUT = 1 + IDOT = 0 + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: LAMBERT CONFORMAL CONIC PROJECTION' + 2 ,2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 30 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 30 CONTINUE +C +C + IPROJ = 4 + POLAT = 20. + POLONG = -40. + ROT = 0. + PL1 = 0. + PL2 = 0. + PL3 = 0. + PL4 = 0. + JLTS = 1 + JGRID = 10 + IUSOUT = 0 + IDOT = 0 + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: LAMBERT EQUAL AREA PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 40 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 40 CONTINUE +C +C + IPROJ = 5 + POLAT = 0. + POLONG = 0. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: GNOMONIC PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 50 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 50 CONTINUE +C +C + IPROJ = 6 + POLAT = -20. + POLONG = 40. + JGRID = 5 + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: AZIMUTHAL EQUIDISTANT PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 60 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 60 CONTINUE +C +C + IPROJ = 8 + POLAT = -40. + POLONG = 80. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: CYLINDRICAL EQUIDISTANT PROJECTION' + 2 ,2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 70 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 70 CONTINUE +C +C + IPROJ = 9 + POLAT = -60. + POLONG = 120. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: MERCATOR PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 80 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 80 CONTINUE +C +C + IPROJ = 10 + POLAT = -80. + POLONG = 160. + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'SUPMAP DEMONSTRATION: MOLLWEIDE TYPE PROJECTION', + 2 2,0,0) + CALL SUPMAP (IPROJ,POLAT,POLONG,ROT,PL1,PL2,PL3,PL4,JLTS,JGRID, + 1 IUSOUT,IDOT,IER) + CALL FRAME + IF (IER .EQ. 0) GO TO 90 +C +C SUPMAP TEST UNSUCCESSFUL +C + WRITE (6,1001) IPROJ + IERROR = 1 + 90 CONTINUE +C +C DEMONSTRATION OF SATELLITE VIEW PROJECTION +C + SL = 6.5 + CALL GSELNT (0) + CALL WTSTR(TX,TY, + 1 'EZMAPG DEMONSTRATION: SATELLITE VIEW PROJECTION', + 2 2,0,0) + CALL MAPROJ('OR',0.0,-135.0,0.0) + CALL MAPSET('MA',0.0,0.0,0.0,0.0) + CALL MAPDRW + CALL FRAME +C +C + IF (IERROR .EQ. 0) WRITE (6,1002) + IF (IERROR .EQ. 1) WRITE (6,1003) + RETURN +C +C + 1001 FORMAT (' SUPMAP RETURNED ERROR FLAG',' IPROJ=',I4/) + 1002 FORMAT(' SUPMAP TEST SUCCESSFUL',24X, + 1 'SEE PLOT TO VERIFY PERFORMANCE') + 1003 FORMAT (' SUPMAP TEST UNSUCCESSFUL') +C + END diff --git a/sys/gio/ncarutil/tests/ezsurface.x b/sys/gio/ncarutil/tests/ezsurface.x new file mode 100644 index 00000000..75abf061 --- /dev/null +++ b/sys/gio/ncarutil/tests/ezsurface.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routine EZSRF. + +procedure t_ezsurface() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tsrfac (1, error_code) + if (error_code == 0) + call printf ("Test of EZSRF successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/ezvelvect.x b/sys/gio/ncarutil/tests/ezvelvect.x new file mode 100644 index 00000000..aeb5a5ab --- /dev/null +++ b/sys/gio/ncarutil/tests/ezvelvect.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routines EZVELVEC + +procedure t_ezvelvect() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tvelvc (1, error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/ezytst.x b/sys/gio/ncarutil/tests/ezytst.x new file mode 100644 index 00000000..b3ac1cb1 --- /dev/null +++ b/sys/gio/ncarutil/tests/ezytst.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> +include <ctype.h> + +# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc. + +task ezytst = t_ezytst + +procedure t_ezytst() + +char device[SZ_FNAME], title[SZ_LINE] +int wkid, i +real y_vector[512] +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + # Construct vector to be plotted + do i = 1, 512 + y_vector[i] = i + + call strcpy ("TIMING TEST: 512 POINT VECTOR$", title, SZ_LINE) + call ezy (y_vector(1), 512, 'Timing Test: 512 Point Vector$') + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/hafton.x b/sys/gio/ncarutil/tests/hafton.x new file mode 100644 index 00000000..63795b22 --- /dev/null +++ b/sys/gio/ncarutil/tests/hafton.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +procedure t_hafton + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call thafto (error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/haftont.f b/sys/gio/ncarutil/tests/haftont.f new file mode 100644 index 00000000..b4cfe017 --- /dev/null +++ b/sys/gio/ncarutil/tests/haftont.f @@ -0,0 +1,123 @@ + SUBROUTINE THAFTO (IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C HAFTON AND TO TEST HAFTON ON A SINGLE +C PROBLEM +C +C USAGE CALL THAFTO (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C HAFTON TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE +C HALF-TONE PLOT ARE PRODUCED ON THE MACHINE +C GRAPHICS DEVICE. IN ORDER TO DETERMINE IF THE +C TEST WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THESE PLOTS. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY HAFTON +C FILES +C +C LANGUAGE ANSI FORTRAN 77 +C +C ALGORITHM THE FUNCTION +C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09) +C -1./((X+.1)**2+Y**2+.09) +C FOR X = -1. TO +1. IN INCREMENTS OF .1 AND +C Y = -1.2 TO +1.2 IN INCREMENTS OF .1 +C IS COMPUTED. +C THAFTO CALLS SUBROUTINES EZHFTN AND HAFTON TO +C DRAW TWO HALF-TONE PLOTS OF THE ARRAY Z. +C +C PORTABILITY ANSI STANDARD +C +C +C Z CONTAINS THE VALUES TO BE PLOTTED. +C +C + REAL Z(21,25) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY +C DEFINE THE CENTER OF THE LEFT EDGE OF THE TITLE STRING. +C + DATA TX/0.0762/, TY/0.9769/ +C +C SPECIFY SOME ARGUMENT VALUES FOR ROUTINE HAFTON. +C FLO CONTAINS THE LOW VALUE DESIGNATION FOR HAFTON, FHI +C CONTAINS THE HIGH VALUE DESIGNATION FOR HAFTON, NLEV +C SPECIFIES THE NUMBER OF UNIQUE LEVELS BETWEEN FLO AND FHI, THE +C ABSOLUTE VALUE OF NOPT DETERMINES THE MAPPING OF Z ONTO THE +C INTENSITIES, AND THE SIGN OF NOPT CONTROLS THE DIRECTNESS OR +C INVERSNESS OF THE MAPPING. +C + DATA FLO/-4.0/, FHI/4.0/, NLEV/8/, NOPT/-3/ +C +C + SAVE +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 0 +C +C FILL TWO DIMENSIONAL ARRAY TO BE PLOTTED +C + DO 20 I=1,21 + X = .1*FLOAT(I-11) + DO 10 J=1,25 + Y = .1*FLOAT(J-13) + Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)- + 1 1./((X+.10)**2+Y**2+.09) + 10 CONTINUE + 20 CONTINUE +C +C SELECT NORMALIZATION TRANS 0 FOR PLOTTING TITLE +C +c CALL GSELNT (0) +C +C +C +C ENTRY EZHFTN REQUIRES ONLY THE ARRAY NAME AND ITS DIMENSIONS +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON +C +c CALL WTSTR (TX,TY, +c 1 'DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON',2,0,-1) +c CALL EZHFTN (Z,21,25) +C +C ENTRY HAFTON ALLOWS USER SPECIFICATIONS OF PLOT PARAMETERS, IF DESIRED +C +C THE TITLE FOR THIS PLOT IS +C +C DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON +C + CALL GSELNT (0) + CALL WTSTR (TX,TY, + 1 'DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON',2,0,-1) + CALL HAFTON (Z,21,21,25,FLO,FHI,NLEV,NOPT,0,0,0.) +c CALL NEWFM +C +c WRITE (6,1001) + RETURN +C +C +c1001 FORMAT (' HAFTON TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/isosrf.x b/sys/gio/ncarutil/tests/isosrf.x new file mode 100644 index 00000000..1216db50 --- /dev/null +++ b/sys/gio/ncarutil/tests/isosrf.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routine ISOSRFHR + +procedure t_isosrf() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tisosr (2, error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/isosrfhrt.f b/sys/gio/ncarutil/tests/isosrfhrt.f new file mode 100644 index 00000000..1d8fb249 --- /dev/null +++ b/sys/gio/ncarutil/tests/isosrfhrt.f @@ -0,0 +1,165 @@ + SUBROUTINE TISOHR (IERROR) +C +C LATEST REVISION JULY 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C THE ISOSRFHR PACKAGE +C +C USAGE CALL TISOHR (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C =0 IF THERE IS A NORMAL EXIT FROM THE +C ISOSRFHR ROUTINES +C =1 OTHERWISE +C +C I/O THIS ROUTINE REQUIRES UNIT IUNIT FOR SCRATCH +C PURPOSES. USERS SHOULD PUT THE UNITS LABELLED +C COMMON (SEE BELOW) IN THE CALLING PROGRAM, +C AND ALSO SET THE VALUE OF THE COMMON VARIABLE +C IUNIT IN THE CALLING PROGRAM. +C +C IF THERE IS A NORMAL EXIT FROM THE +C ISOSRFHR ROUTINES THE MESSAGE +C ISOSRFHR TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C IS PRINTED. +C +C ALSO, A SAMPLE PLOT IS +C PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. ONE MUST EXAMINE THIS PLOT +C TO DETERMINE IF THE ROUTINES HAVE +C EXECUTED CORRECTLY. +C +C COMMON BLOCKS UNITS +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY ISOSRFHR +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM THIS SUBROUTINE USES THE ROUTINES IN +C THE PACKAGE ISOSRFHR TO DRAW A PERSPECTIVE +C DRAWING OF TWO INTERLOCKING DOUGHNUTS +C +C PORTABILITY ANSI STANDARD +C +C + DIMENSION EYE(3) ,S(4) ,IS2(4,200) , + 1 ST1(81,51,2) ,IOBJS(81,51) + COMMON /UNITS/ IUNIT +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 1 TO 1024, THE VALUES IX AND IY +C DEFINE THE CENTER OF THE TITLE STRING. +C + DATA IX/448/, IY/990/ +C +C +C DEFINE THE EYE POSITION +C + DATA EYE(1), EYE(2), EYE(3) / 200., 250., 250. / +C +C DEFINE THE OVERALL DIMENSION OF THE BOX CONTAINING THE OBJECTS +C + DATA NU, NV, NW / 51, 81, 51 / +C +C SPECIFY THE DIMENSIONS OF THE MODEL OF THE IMAGE PLANE +C + DATA LX, NX, NY / 4, 180, 180 / +C +C SPECIFY CRT COORDINATES OF THE AREA WHERE THE PICTURE +C IS TO BE DRAWN +C + DATA S(1),S(2),S(3),S(4)/ 10.,1010.,10.,1010./ + DATA MV / 81 / +C +C SPECIFY THE LARGE AND SMALL RADII FOR THE INDIVIDUAL DOUGHNUTS +C + DATA RBIG1,RBIG2,RSML1,RSML2/ 20., 20., 6., 6. / +C + SAVE +C +C CALL THE INITIALIZATION ROUTINE +C + CALL INIT3D (EYE,NU,NV,NW,ST1,LX,NY,IS2,IUNIT,S) +C +C INITIALIZE THE ERRROR FLAG +C + IERROR = 1 +C +C CREATE AND PLOT DATA FOR TWO INTERLOCKING DOUGHNUTS +C + JCENT1 = FLOAT(NV)*.5-RBIG1*.5 + JCENT2 = FLOAT(NV)*.5+RBIG2*.5 + DO 70 IBKWDS=1,NU + I = NU+1-IBKWDS +C +C CREATE THE I-TH CROSS SECTION IN THE U DIRECTION OF THE +C THREE-DIMENSIONAL ARRAY AND STORE IN IOBJS AS ZEROS AND ONES +C + FIMID = I-NU/2 + DO 20 J=1,NV + FJMID1 = J-JCENT1 + FJMID2 = J-JCENT2 + DO 10 K=1,NW + FKMID = K-NW/2 + F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1)) + F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1)) + FIP1 = (1.-F1)*FIMID + FIP2 = (1.-F2)*FIMID + FJP1 = (1.-F1)*FJMID1 + FJP2 = (1.-F2)*FJMID2 + FKP1 = (1.-F1)*FKMID + FKP2 = (1.-F2)*FKMID + TEMP = AMIN1(FIMID**2+FJP1**2+FKP1**2-RSML1**2, + 1 FKMID**2+FIP2**2+FJP2**2-RSML2**2) + IF (TEMP .LE. 0.) IOBJS(J,K) = 1 + IF (TEMP .GT. 0.) IOBJS(J,K) = 0 + 10 CONTINUE + 20 CONTINUE +C +C SET PROPER WORDS TO 1 FOR DRAWING AXES +C + IF (I .NE. 1) GO TO 50 + DO 30 K=1,NW + IOBJS(1,K) = 1 + 30 CONTINUE + DO 40 J=1,NV + IOBJS(J,1) = 1 + 40 CONTINUE + GO TO 60 + 50 CONTINUE + IOBJS(1,1) = 1 + 60 CONTINUE +C +C CALL THE DRAW AND REMEMBER ROUTINE FOR THIS SLAB +C + CALL DANDR (NV,NW,ST1,LX,NX,NY,IS2,IUNIT,S,IOBJS,MV) + 70 CONTINUE +C +C TITLE THE PLOT +C + CALL GQCNTN(IER,ICN) + CALL GSELNT(0) + XC = PAU2FX(IX) + YC = PAU2FY(IY) + CALL WTSTR(XC,YC,'DEMONSTRATION PLOT FOR ISOSRFHR',2,0,0) + CALL GSELNT(ICN) +C +C ADVANCE THE PLOTTING DEVICE +C +c CALL NEWFM +C + IERROR = 0 +c WRITE (6,1001) + RETURN +C +c1001 FORMAT (' ISOSRFHR TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/isosrft.f b/sys/gio/ncarutil/tests/isosrft.f new file mode 100644 index 00000000..1e99e02e --- /dev/null +++ b/sys/gio/ncarutil/tests/isosrft.f @@ -0,0 +1,137 @@ + SUBROUTINE TISOSR (nplot, IERROR) +C +C LATEST REVISION DECEMBER 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C ISOSRF AND TO TEST ISOSRF ON A SINGLE PROBLEM +C +C USAGE CALL TISOSR (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C ISOSRF TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS WRITTEN ON UNIT 6. +C IN ADDITION, TWO FRAMES CONTAINING THE SAMPLE +C PLOTS ARE PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. IN ORDER TO DETERMINE IF THE TEST +C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THESE PLOTS. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY ISOSRF FROM ULIB LIBRARY +C FILES +C +C LANGUAGE STANDARD FORTRAN77 +C +C HISTORY WRITTEN BY MEMBERS OF THE +C SCIENTIFIC COMPUTING DIVISION OF NCAR, +C BOULDER COLORADO +C +C ALGORITHM A FUNCTION OF THREE VARIABLES IS DEFINED, AND +C VALUES OF THE FUNCTION ON A THREE DIMENSIONAL +C RECTANGULAR GRID ARE STORED IN AN ARRAY. THIS +C SUBROUTINE CALLS EZISOS AND ISOSRF TO DRAW ISO- +C VALUED SURFACE PLOTS OF THE FUNCTION. +C +C PORTABILITY ANSI STANDARD +C +C + SAVE + DIMENSION T(21,31,19),SLAB(33,33),EYE(3) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 1 TO 1024, THE VALUES IX AND IY +C DEFINE THE CENTER OF THE TITLE STRING. +C + REAL IX,IY + DATA IX/.44/, IY/.95/ +C + DATA NU,NV,NW/21,31,19/ + DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./ + DATA TISO/0./ + DATA MUVWP2/33/ + DATA IFLAG/-7/ +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 1 +C +C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED +C + JCENT1 = FLOAT(NV)*.5-RBIG1*.5 + JCENT2 = FLOAT(NV)*.5+RBIG2*.5 + DO 30 I=1,NU + FIMID = I-NU/2 + DO 20 J=1,NV + FJMID1 = J-JCENT1 + FJMID2 = J-JCENT2 + DO 10 K=1,NW + FKMID = K-NW/2 + F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1)) + F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1)) + FIP1 = (1.-F1)*FIMID + FIP2 = (1.-F2)*FIMID + FJP1 = (1.-F1)*FJMID1 + FJP2 = (1.-F2)*FJMID2 + FKP1 = (1.-F1)*FKMID + FKP2 = (1.-F2)*FKMID + T(I,J,K) = AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1- + 1 RSML1*RSML1, + 2 FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2) + 10 CONTINUE + 20 CONTINUE + 30 CONTINUE +C +C DEFINE EYE POSITION +C + EYE(1) = 100. + EYE(2) = 150. + EYE(3) = 125. +C +C LABEL THE PLOT TO BE DRAWN BY EZISOS +C + if (nplot .eq. 1) then + CALL GSELNT(0) + CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY EZISOS OF ISOSRF', + 1 2,0,0) +C +C TEST EZISOS +C + CALL EZISOS (T,NU,NV,NW,EYE,SLAB,TISO) + endif +C +C LABEL THE PLOT TO BE DRAWN BY ISOSRF +C + if (nplot .eq. 2) then + CALL GSELNT(0) + CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY ISOSRF OF ISOSRF', + 1 2,0,0) +C +C TEST ISOSRF WITH SUBARRAY OF T +C + MU=NU/2 + MV=NV/2 + MW=NW/2 + MUVWP2=MAX0(MU,MV,MW)+2 + CALL ISOSRF(T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO,IFLAG) + endif +c CALL FRAME +C + IERROR = 0 +c WRITE (6,1001) + RETURN +C +c1001 FORMAT (' ISOSRF TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/mkpkg b/sys/gio/ncarutil/tests/mkpkg new file mode 100644 index 00000000..79beff4f --- /dev/null +++ b/sys/gio/ncarutil/tests/mkpkg @@ -0,0 +1,65 @@ +# Make the x_ncartest.e executable for testing the NCAR utilities. + #conraq.x <error.h> <gset.h> + #conraqt.f + #conras.x <error.h> <gset.h> + #conrast.f + #conrcqckt.f + #conrcsmtht.f + #conrcsprt.f + #dashchar.x + #dashchart.f + #dashlinet.f + #dashsuprt.f + #ezmapg.x <error.h> <gset.h> + #ezmapgt.f + #ezmapt.f + #isosrfhrt.f + +$update libpkg.a +$omake x_ncartest.x +$link x_ncartest.o libpkg.a -lncar -lgks -o /tmp2/newncar/x_ncartest.e +$exit + +libpkg.a: + auto10t.f + autograph.x <ctype.h> <error.h> <gset.h> + autographt.f + conran.x <error.h> <gset.h> + conrant.f + conrec.x <error.h> <gset.h> + conrect.f + dashsmth.x + dashsmtht.f + ezconrec.x <error.h> <gset.h> + ezhafton.x <error.h> <gset.h> + ezhaftont.f + ezisosrf.x <error.h> <gset.h> + ezsurface.x <error.h> <gset.h> + ezvelvect.x <error.h> <gset.h> + ezytst.x <ctype.h> <error.h> <gset.h> + hafton.x <error.h> <gset.h> + haftont.f + isosrf.x <error.h> <gset.h> + isosrft.f + oldauto.x <ctype.h> <error.h> <gset.h> + oldautot.f + preal.x + pwrity.x + pwrityt.f + pwrzit.f + pwrzs.x + pwrzst.f + pwrztt.f + srfacet.f + srftest.x + srftestd.x + strmln.x <error.h> <gset.h> + strmlnt.f + surface.x <error.h> <gset.h> + threed.x <error.h> <gset.h> + threed2.x <error.h> <gset.h> + threed2t.f + threedt.f + velvctt.f + velvect.x <error.h> <gset.h> + ; diff --git a/sys/gio/ncarutil/tests/oldauto.x b/sys/gio/ncarutil/tests/oldauto.x new file mode 100644 index 00000000..90287803 --- /dev/null +++ b/sys/gio/ncarutil/tests/oldauto.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> +include <ctype.h> + +# Test NCAR routine AUTOGRAPH - EZXY, EZMXY etc. + +procedure t_oldauto() + +char device[SZ_FNAME], command[SZ_LINE] +int error_code, wkid +int ctoi() +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call exmpl1 + call exmpl2 + call exmpl3 + call exmpl4 + call exmpl5 + call exmpl6 + call exmpl7 + call exmpl8 + # call exmpl9 + call xmpl11 + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/oldautot.f b/sys/gio/ncarutil/tests/oldautot.f new file mode 100644 index 00000000..168d5f37 --- /dev/null +++ b/sys/gio/ncarutil/tests/oldautot.f @@ -0,0 +1,833 @@ + SUBROUTINE EXMPL1 +C +C Define the data array. +C + REAL YDRA(1001) +C +C Fill the data array. +C + DO 101 I=1,1001 + X=FLOAT(I)/20. + YDRA(I)=10.*(X-1.)*(X-11.)*(X-21.)*(X-31.)*(X-41.)*(X-51.) + + +2.E7*(FRAN()-.5) + 101 CONTINUE +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Draw the graph, using EZY. +C + CALL EZY (YDRA,1001,'EXAMPLE 1 (EZY)$') +C +c STOP +C + END + FUNCTION FRAN() +C +C Random-number generator. +C + DATA X / 2.7182818 / + SAVE X + X=AMOD(9821.*X+.211327,1.) + FRAN=X + RETURN + END + SUBROUTINE BNDARY +C +C Routine to draw the plotter-frame edge. +C + CALL PLOTIT ( 0, 0,0) + CALL PLOTIT (32767, 0,1) + CALL PLOTIT (32767,32767,1) + CALL PLOTIT ( 0,32767,1) + CALL PLOTIT ( 0, 0,1) + RETURN + END +c + SUBROUTINE EXMPL2 +C +C Define the data arrays. +C + REAL XDRA(4001),YDRA(4001) +C +C Fill the data arrays. +C + DO 101 I=1,4001 + THETA=.0015707963267949*FLOAT(I-1) + RHO=SIN(2.*THETA)+.05*SIN(64.*THETA) + XDRA(I)=RHO*COS(THETA) + YDRA(I)=RHO*SIN(THETA) + 101 CONTINUE +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Draw the graph, using EZXY. +C + CALL EZXY (XDRA,YDRA,4001,'EXAMPLE 2 (EZXY)$') +C +c STOP +C + END +c + SUBROUTINE EXMPL3 +C +C Define the data array. +C + REAL YDRA(100,2) +C +C Fill the data array. +C + DO 101 I=1,100 + YDRA(I,1)=COS(3.14159265358979*FLOAT(I)/25.)*FLOAT(I)**2 + YDRA(I,2)=COS(3.14159265358979*FLOAT(I)/25.)*10.**(.04*FLOAT(I)) + 101 CONTINUE +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Draw the graph, using EZMY. +C + CALL EZMY (YDRA,100,2,100,'EXAMPLE 3 (EZMY)$') +C +c STOP +C + END +c + SUBROUTINE EXMPL4 +C +C Define the data arrays. +C + REAL XDRA(201),YDRA(201,10) +C +C Fill the data arrays. +C + DO 102 I=1,201 + XDRA(I)=-1.+.02*FLOAT(I-1) + IF (I.GT.101) XDRA(I)=2.-XDRA(I) + DO 101 J=1,10 + YDRA(I,J)=FLOAT(J)*SQRT(1.000000000001-XDRA(I)**2)/10. + IF (I.GT.101) YDRA(I,J)=-YDRA(I,J) + 101 CONTINUE + 102 CONTINUE +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Draw the graph, using EZMXY. +C + CALL EZMXY (XDRA,YDRA,201,10,201,'EXAMPLE 4 (EZMXY)$') +C +c STOP +C + END +c + SUBROUTINE EXMPL5 +C +C Define the data arrays. +C + REAL XDRA(401,6),YDRA(401,6) +C +C Compute required constants. +C + PI=3.14159265358979 + PID200=PI/200. + PITTWO=2.*PI + PIT2D3=2.*PI/3. + PIT4D3=4.*PI/3. + RADOSC=SQRT(3.)/3. + RADOLC=SQRT(3.)/2. + BSSCLL=ATAN(SQRT(12.)/6.) + BSSCUL=ATAN(SQRT(143.)/7.) + BSLCLL=ATAN(SQRT(143.)/17.) + BSLCUL=ATAN(SQRT(2.0)) +C +C Fill the data arrays. +C + DO 101 I=1,401 + THETA=PID200*FLOAT(I-1) + XDRA(I,1)= -.5+RADOSC*COS(THETA) + YDRA(I,1)= RADOSC*SIN(THETA) + IF (ABS(THETA ).GE.BSSCLL.AND. + + ABS(THETA ).LE.BSSCUL) XDRA(I,1)=1.E36 + IF (ABS(THETA-PITTWO).GE.BSSCLL.AND. + + ABS(THETA-PITTWO).LE.BSSCUL) XDRA(I,1)=1.E36 + XDRA(I,2)= .5+RADOSC*COS(THETA) + YDRA(I,2)= RADOSC*SIN(THETA) + IF (ABS(THETA-PIT2D3).GE.BSSCLL.AND. + + ABS(THETA-PIT2D3).LE.BSSCUL) XDRA(I,2)=1.E36 + XDRA(I,3)= RADOSC*COS(THETA) + YDRA(I,3)=RADOLC+RADOSC*SIN(THETA) + IF (ABS(THETA-PIT4D3).GE.BSSCLL.AND. + + ABS(THETA-PIT4D3).LE.BSSCUL) XDRA(I,3)=1.E36 + XDRA(I,4)= -.5+RADOLC*COS(THETA) + YDRA(I,4)= RADOLC*SIN(THETA) + IF (ABS(THETA ).GE.BSLCLL.AND. + + ABS(THETA ).LE.BSLCUL) XDRA(I,4)=1.E36 + IF (ABS(THETA-PITTWO).GE.BSLCLL.AND. + + ABS(THETA-PITTWO).LE.BSLCUL) XDRA(I,4)=1.E36 + XDRA(I,5)= .5+RADOLC*COS(THETA) + YDRA(I,5)= RADOLC*SIN(THETA) + IF (ABS(THETA-PIT2D3).GE.BSLCLL.AND. + + ABS(THETA-PIT2D3).LE.BSLCUL) XDRA(I,5)=1.E36 + XDRA(I,6)= RADOLC*COS(THETA) + YDRA(I,6)=RADOLC+RADOLC*SIN(THETA) + IF (ABS(THETA-PIT4D3).GE.BSLCLL.AND. + + ABS(THETA-PIT4D3).LE.BSLCUL) XDRA(I,6)=1.E36 + 101 CONTINUE +C +C Specify subscripting of XDRA and YDRA. +C + CALL AGSETI ('ROW.',2) +C +C Make sure grid shape is such that one unit in x = one unit in y. +C + CALL AGSETF ('GRID/SHAPE.',2.) +C +C Turn off background, then turn labels back on. +C + CALL AGSETF ('BACKGROUND.',4.) + CALL AGSETI ('LABEL/CONTROL.',2) +C +C Turn off left label. +C + CALL AGSETC ('LABEL/NAME.','L') + CALL AGSETI ('LABEL/SUPPRESSION FLAG.',1) +C +C Change text of bottom label. +C + CALL AGSETC ('LABEL/NAME.','B') + CALL AGSETI ('LINE/NUMBER.',-100) + CALL AGSETC ('LINE/TEXT.','PURITY, BODY, AND FLAVOR$') +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Draw the graph, using EZMXY. +C + CALL EZMXY (XDRA,YDRA,401,6,401,'EXAMPLE 5 (EZMXY)$') +C +c STOP +C + END +c + SUBROUTINE EXMPL6 +C +C Define the data arrays. +C + REAL XDRA(501),YDRA(501) +C + CHARACTER*35 GLAB + CHARACTER*23 BACK(4) + CHARACTER*12 LNLG(4) + character*1 tmp +C Define the graph-window parameter array. +C + REAL GWND (4,4) +C + DATA (GWND(I,1),I=1,4) / 0.0 , 0.5 , 0.5 , 1.0 / + DATA (GWND(I,2),I=1,4) / 0.5 , 1.0 , 0.5 , 1.0 / + DATA (GWND(I,3),I=1,4) / 0.0 , 0.5 , 0.0 , 0.5 / + DATA (GWND(I,4),I=1,4) / 0.5 , 1.0 , 0.0 , 0.5 / +C +C Define variables used in setting up informational labels on the graph. +C +C + DATA BACK(1) / '(PERIMETER BACKGROUND)$' / + DATA BACK(2) / '(GRID BACKGROUND)$ ' / + DATA BACK(3) / '(HALF-AXIS BACKGROUND)$' / + DATA BACK(4) / '(NO BACKGROUND)$ ' / +C + DATA LNLG(1) / 'LINEAR$' / + DATA LNLG(2) / 'LOGARITHMIC$' / +C +C Fill the data arrays. +C + DO 101 I=1,501 + THETA=.031415926535898*FLOAT(I-1) + XDRA(I)=500.+.9*FLOAT(I-1)*COS(THETA) + YDRA(I)=500.+.9*FLOAT(I-1)*SIN(THETA) + 101 CONTINUE +C +C +C Do four graphs on the same frame, using different backgrounds. +C + DO 102 IGRF = 1,4 +C +C Suppress the frame advance. +C + CALL AGSETI ('FRAME.',2) +C +C Position the graph window. +C + CALL AGSETP ('GRAPH WINDOW.',GWND(1,IGRF),4) +C +C Declare the background type. +C + CALL AGSETI ('BACKGROUND TYPE.',IGRF) +C +C Setting the background type may have turned the informational labels +C off. In that case, turn them back on. +C + IF (IGRF.EQ.4) CALL AGSETI ('LABEL/CONTROL.',2) +C +C Set up parameters determining the linear/log nature of the axes. +C + ILLX=(IGRF-1)/2 + ILLY=MOD(IGRF-1,2) +C +C Declare the linear/log nature of the graph. +C + CALL AGSETI ('X/LOGARITHMIC.',ILLX) + CALL AGSETI ('Y/LOGARITHMIC.',ILLY) +C +C Change the x- and y-axis labels to reflect the linear/log nature of +C the graph. +C + CALL AGSETC ('LABEL/NAME.','B') + CALL AGSETI ('LINE/NUMBER.',-100) + CALL AGSETC ('LINE/TEXT.',LNLG(ILLX+1)) +C + CALL AGSETC ('LABEL/NAME.','L') + CALL AGSETI ('LINE/NUMBER.',100) + CALL AGSETC ('LINE/TEXT.',LNLG(ILLY+1)) +C +C Set up the label for the top of the graph. +C +c WRITE (GLAB,1001) IGRF,BACK(IGRF) + glab(1:35) = 'EXAMPLE 6- ' + glab(11:11) = char (igrf + ichar ('0')) + glab(13:35) = back (igrf) +C +C Draw the graph, using EZXY. +C + CALL EZXY (XDRA,YDRA,501,GLAB) +C + 102 CONTINUE +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Advance the frame. +C + CALL FRAME +C +c STOP +C +C Format for encode. +C +c1001 FORMAT ('EXAMPLE 6-',I1,' ',A23) + END +c + SUBROUTINE EXMPL7 +C +C Define the data arrays and the dash-pattern array. +C + REAL XDRA(101),YDRA(101,9) + CHARACTER*28 DSHP(9) +C +C Declare the type of the dash-pattern-name generator. +C + CHARACTER*16 AGDSHN +C +C Fill the data arrays and the dash pattern array. +C + DO 101 I=1,101 + XDRA(I)=-90.+1.8*FLOAT(I-1) + 101 CONTINUE +C + DO 103 J=1,9 +c WRITE (DSHP(J),1001) J + dshp(j) = '$$$$$$$$$$$$$$$$$$$$$ J = ' + dshp(j)(27:27) = char (j + ichar ('0')) + FJ=J + DO 102 I=1,101 + YDRA(I,J)=3.*FJ-(FJ/2700.)*XDRA(I)**2 + 102 CONTINUE + 103 CONTINUE +C +C Turn on windowing. (Some curves run outside the curve window.) +C + CALL AGSETI ('WINDOWING.',1) +C +C Move the edges of the curve window (grid). +C + CALL AGSETF ('GRID/LEFT.' ,.10) + CALL AGSETF ('GRID/RIGHT.' ,.90) + CALL AGSETF ('GRID/BOTTOM.',.10) + CALL AGSETF ('GRID/TOP.' ,.85) +C +C Set the x and y minimum and maximum. +C + CALL AGSETF ('X/MINIMUM.',-90.) + CALL AGSETF ('X/MAXIMUM.',+90.) + CALL AGSETF ('Y/MINIMUM.', 0.) + CALL AGSETF ('Y/MAXIMUM.', 18.) +C +C Set left axis parameters. +C + CALL AGSETI ('LEFT/MAJOR/TYPE.',1) + CALL AGSETF ('LEFT/MAJOR/BASE.',3.) + CALL AGSETI ('LEFT/MINOR/SPACING.',2) +C +C Set right axis parameters. +C + CALL AGSETI ('RIGHT/FUNCTION.',1) + CALL AGSETF ('RIGHT/NUMERIC/TYPE.',1.E36) +C +C Set bottom axis parameters. +C + CALL AGSETI ('BOTTOM/MAJOR/TYPE.',1) + CALL AGSETF ('BOTTOM/MAJOR/BASE.',15.) + CALL AGSETI ('BOTTOM/MINOR/SPACING.',2) +C +C Set top axis parameters. +C + CALL AGSETI ('TOP/FUNCTION.',1) + CALL AGSETF ('TOP/NUMERIC/TYPE.',1.E36) +C +C Set up the dash patterns to be used. +C + CALL AGSETI ('DASH/SELECTOR.',9) + CALL AGSETI ('DASH/LENGTH.',28) + DO 104 I=1,9 + CALL AGSETC (AGDSHN(I),DSHP(I)) + 104 CONTINUE +C +C Set up the left label. +C + CALL AGSETC ('LABEL/NAME.','L') + CALL AGSETI ('LINE/NUMBER.',100) + CALL AGSETC ('LINE/TEXT.','HEIGHT (KILOMETERS)$') +C +C Set up the right label. +C + CALL AGSETC ('LABEL/NAME.','R') + CALL AGSETI ('LINE/NUMBER.',-100) + CALL AGSETC ('LINE/TEXT.','PRESSURE (TONS/SQUARE FURLONG)$') +C +C Set up the bottom labels. +C + CALL AGSETC ('LABEL/NAME.','B') + CALL AGSETI ('LINE/NUMBER.',-100) + CALL AGSETC ('LINE/TEXT.','LATITUDE (DEGREES)$') +C + CALL AGSETC ('LABEL/NAME.','SP') + CALL AGSETF ('LABEL/BASEPOINT/X.',.000001) + CALL AGSETF ('LABEL/BASEPOINT/Y.',0.) + CALL AGSETF ('LABEL/OFFSET/Y.',-.015) + CALL AGSETI ('LINE/NUMBER.',-100) + CALL AGSETC ('LINE/TEXT.','SP$') +C + CALL AGSETC ('LABEL/NAME.','NP') + CALL AGSETF ('LABEL/BASEPOINT/X.',.999999) + CALL AGSETF ('LABEL/BASEPOINT/Y.',0.) + CALL AGSETF ('LABEL/OFFSET/Y.',-.015) + CALL AGSETI ('LINE/NUMBER.',-100) + CALL AGSETC ('LINE/TEXT.','NP$') +C +C Set up the top label. +C + CALL AGSETC ('LABEL/NAME.','T') + CALL AGSETI ('LINE/NUMBER.',80) + CALL AGSETC ('LINE/TEXT.','DISTANCE FROM EQUATOR (MILES)$') + CALL AGSETI ('LINE/NUMBER.',90) + CALL AGSETC ('LINE/TEXT.',' $') + CALL AGSETI ('LINE/NUMBER.',100) + CALL AGSETC ('LINE/TEXT.','LINES OF CONSTANT INCRUDESCENCE$') + CALL AGSETI ('LINE/NUMBER.',110) + CALL AGSETC ('LINE/TEXT.','EXAMPLE 7 (EZMXY)$') +C +C Set up centered (box 6) label. +C + CALL AGSETC ('LABEL/NAME.','EQUATOR') + CALL AGSETI ('LABEL/ANGLE.',90) + CALL AGSETI ('LINE/NUMBER.',0) + CALL AGSETC ('LINE/TEXT.','EQUATOR$') +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Draw the graph, using EZMXY. +C + CALL EZMXY (XDRA,YDRA,101,9,101,0) +C +c STOP +C +C Format for encode above. +C +c1001 FORMAT ('$$$$$$$$$$$$$$$$$$$$$''J''=''',I1,'''') +C + END +c + SUBROUTINE EXMPL8 +C +C Define the data arrays. +C + REAL XDRA(101),YDRA(4,101) +C +C Fill the data arrays. +C + DO 101 I=1,101 + XDRA(I)=-3.14159265358979+.062831853071796*FLOAT(I-1) + 101 CONTINUE +C + DO 103 I=1,4 + FLTI=I + BASE=2.*FLTI-1. + DO 102 J=1,101 + YDRA(I,J)=BASE+.75*SIN(-3.14159265358979+.062831853071796* + + FLTI*FLOAT(J-1)) + 102 CONTINUE + 103 CONTINUE +C +C Change the line-end character to a period. +C + CALL AGSETC ('LINE/END.','.') +C +C Specify labels for x and y axes. +C + CALL ANOTAT ('SINE FUNCTIONS OF T.','T.',0,0,0,0) +C +C Use a half-axis background. +C + CALL AGSETI ('BACKGROUND.',3) +C +C Move x axis to the zero point on the y axis. +C + CALL AGSETF ('BOTTOM/INTERSECTION/USER.',0.) +C +C Specify base value for spacing of major ticks on x axis. +C + CALL AGSETF ('BOTTOM/MAJOR/BASE.',1.) +C +C Run major ticks on x axis to edge of curve window. +C + CALL AGSETF ('BOTTOM/MAJOR/INWARD.',1.) + CALL AGSETF ('BOTTOM/MAJOR/OUTWARD.',1.) +C +C Position x axis minor ticks. +C + CALL AGSETI ('BOTTOM/MINOR/SPACING.',9) +C +C Run the y axis backward. +C + CALL AGSETI ('Y/ORDER.',1) +C +C Run plots full-scale in y. +C + CALL AGSETI ('Y/NICE.',0) +C +C Have AUTOGRAPH scale x and y data the same. +C + CALL AGSETF ('GRID/SHAPE.',.01) +C +C Use the alphabetic set of dashed-line patterns. +C + CALL AGSETI ('DASH/SELECTOR.',-1) +C +C Tell AUTOGRAPH how the data arrays are dimensioned. +C + CALL AGSETI ('ROW.',-1) +C +C Reverse the roles of the x and y arrays. +C + CALL AGSETI ('INVERT.',1) +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Draw the curves. +C + CALL EZMXY (XDRA,YDRA,4,4,101,'EXAMPLE 8.') +C +c STOP +C + END +c +C SUBROUTINE EXMPL9 +CC +CC Define the data arrays. +CC +C DIMENSION XDAT(400),YDAT(400) +CC +CC Fill the data arrays. +CC +C DO 101 I=1,400 +C XDAT(I)=(FLOAT(I)-1.)/399. +C 101 CONTINUE +CC +C CALL GENDAT (YDAT( 1),200,200,1,3,3,+.01,+10.) +C CALL GENDAT (YDAT(201),200,200,1,3,3,-10.,-.01) +CC +CC The y data ranges over both positive and negative values. It is +CC desired that both ranges be represented on the same graph and that +CC each be shown logarithmically, ignoring values in the range -.01 to +CC +.01, in which we're not interested. First we map each y datum into +CC its absolute value (.01 if the absolute value is too small). Then we +CC take the base-10 logarithm, add 2.0001 (so as to be sure of getting a +CC positive number), and re-attach the original sign. We can plot the +CC resulting y data on a linear y axis. +CC +C DO 102 I=1,400 +C YDAT(I)=SIGN(ALOG10(AMAX1(ABS(YDAT(I)),.01))+2.0001,YDAT(I)) +C 102 CONTINUE +CC +CC In order that the labels on the y axis should show the original values +CC of the y data, we change the user-system-to-label-system mapping on +CC both y axes and force major ticks to be spaced logarithmically in the +CC label system (which will be defined by the subroutine AGUTOL in such +CC a way as to re-create numbers in the original range). +CC +C CALL AGSETI ('LEFT/FUNCTION.',1) +C CALL AGSETI ('LEFT/MAJOR/TYPE.',2) +CC +C CALL AGSETI ('RIGHT/FUNCTION.',1) +C CALL AGSETI ('RIGHT/MAJOR/TYPE.',2) +CC +CC Change the label on the left axis to reflect what's going on. +CC +C CALL AGSETC ('LABEL/NAME.','L') +C CALL AGSETI ('LINE/NUMBER.',100) +C CALL AGSETC ('LINE/TEXT.','LOG SCALING, POSITIVE AND NEGATIVE$') +CC +CC Draw a boundary around the edge of the plotter frame. +CC +Cc CALL BNDARY +CC +CC Draw the curve. +CC +C CALL EZXY (XDAT,YDAT,400,'EXAMPLE 9$') +CC +Cc STOP +CC +C END +Cc +C SUBROUTINE GENDAT (DATA,IDIM,M,N,MLOW,MHGH,DLOW,DHGH) +CC +CC This is a routine to generate test data for two-dimensional graphics +CC routines. Given an array "DATA", dimensioned "IDIM x 1", it fills +CC the sub-array ((DATA(I,J),I=1,M),J=1,N) with a two-dimensional field +CC of data having approximately "MLOW" lows and "MHGH" highs, a minimum +CC value of exactly "DLOW" and a maximum value of exactly "DHGH". +CC +CC "MLOW" and "MHGH" are each forced to be greater than or equal to 1 +CC and less than or equal to 25. +CC +CC The function used is a sum of exponentials. +CC +C DIMENSION DATA(IDIM,1),CCNT(3,50) +CC +C FOVM=9./FLOAT(M) +C FOVN=9./FLOAT(N) +CC +C NLOW=MAX0(1,MIN0(25,MLOW)) +C NHGH=MAX0(1,MIN0(25,MHGH)) +C NCNT=NLOW+NHGH +CC +C DO 101 K=1,NCNT +C CCNT(1,K)=1.+(FLOAT(M)-1.)*FRAN() +C CCNT(2,K)=1.+(FLOAT(N)-1.)*FRAN() +C IF (K.LE.NLOW) THEN +C CCNT(3,K)=-1. +C ELSE +C CCNT(3,K)=+1. +C END IF +C 101 CONTINUE +CC +C DMIN=+1.E36 +C DMAX=-1.E36 +C DO 104 J=1,N +C DO 103 I=1,M +C DATA(I,J)=.5*(DLOW+DHGH) +C DO 102 K=1,NCNT +C DATA(I,J)=DATA(I,J) + .5 * (DHGH-DLOW) * CCNT(3,K) * +C + EXP( - ( ( FOVM*(FLOAT(I)-CCNT(1,K)) )**2 + +C + ( FOVN*(FLOAT(J)-CCNT(2,K)) )**2 ) ) +C 102 CONTINUE +C DMIN=AMIN1(DMIN,DATA(I,J)) +C DMAX=AMAX1(DMAX,DATA(I,J)) +C 103 CONTINUE +C 104 CONTINUE +CC +C DO 106 J=1,N +C DO 105 I=1,M +C DATA(I,J)=(DATA(I,J)-DMIN)/(DMAX-DMIN)*(DHGH-DLOW)+DLOW +C 105 CONTINUE +C 106 CONTINUE +CC +C RETURN +CC +C END +Cc +C SUBROUTINE XMPL10 +C RETURN +C END +Cc + SUBROUTINE XMPL11 +C +C Create a sort of histogram. +C + REAL XDRA(249),YDRA(249),WORK(204),IWRK(204) +C +C Fill the data arrays. First, we define the histogram outline. This +C will be used in the call to FILL which fills in the area under the +C histogram. +C + XDRA(1)=0. + YDRA(1)=0. +C + DO 101 I=2,100,2 + XDRA(I )=XDRA(I-1) + YDRA(I )=EXP(-16.*(FLOAT(I/2)/50.-.51)**2)+.1*FRAN() + XDRA(I+1)=XDRA(I-1)+.02 + YDRA(I+1)=YDRA(I) + 101 CONTINUE +C + XDRA(102)=1. + YDRA(102)=0. +C +C Then, we define lines separating the vertical boxes from each other. +C + NDRA=102 +C + DO 102 I=3,99,2 + XDRA(NDRA+1)=1.E36 + YDRA(NDRA+1)=1.E36 + XDRA(NDRA+2)=XDRA(I) + YDRA(NDRA+2)=0. + XDRA(NDRA+3)=XDRA(I) + YDRA(NDRA+3)=AMIN1(YDRA(I),YDRA(I+1)) + NDRA=NDRA+3 + 102 CONTINUE +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Suppress the frame advance. +C + CALL AGSETI ('FRAME.',2) +C +C Draw the graph, using EZXY. +C + CALL EZXY (XDRA,YDRA,249,'EXAMPLE 11 (HISTOGRAM)$') +C +C Use the XLIB routine FILL to fill the area defined by the data. Note +C that FILL is not a part of the AUTOGRAPH package. +C +c CALL FILLOP ('AN',45) +c CALL FILLOP ('SP',128) +c CALL FILL (XDRA,YDRA,102,WORK,204,IWRK,204) +C +C Advance the frame. +C +c CALL FRAME +C +c STOP +C + END +c + SUBROUTINE EXMPLF +C +C Define the data array. +C + DIMENSION XYCD(226) +C +C Fill the data array. +C +c READ 1001 , XYCD +C + DO 101 I=1,226 + IF (XYCD(I).EQ.1.E36) GO TO 101 + XYCD(I)=2.**((XYCD(I)-15.)/2.5) + 101 CONTINUE +C +C Specify log/log plot. +C + CALL DISPLA (0,0,4) +C +C Bump the line-maximum parameter past 42. +C + CALL AGSETI ('LINE/MAXIMUM.',50) +C +C Specify x- and y-axis labels, grid background. +C + CALL ANOTAT ('LOGARITHMIC, BASE 2, EXPONENTIAL LABELING$', + + 'LOGARITHMIC, BASE 2, NO-EXPONENT LABELING$',2,0,0,0) +C +C Specify the graph label. +C + CALL AGSETC ('LABEL/NAME.','T') + CALL AGSETI ('LINE/NUMBER.',100) + CALL AGSETC ('LINE/TEXT.','FINAL EXAMPLE$') +C +C Specify x-axis ticks and labels. +C + CALL AGSETI ('BOTTOM/MAJOR/TYPE.',3) + CALL AGSETF ('BOTTOM/MAJOR/BASE.',2.) + CALL AGSETI ('BOTTOM/NUMERIC/TYPE.',2) + CALL AGSETI ('BOTTOM/MINOR/SPACING.',4) +c CALL AGSETI ('BOTTOM/MINOR/PATTERN.',125252B) +C +C Specify y-axis ticks and labels. +C + CALL AGSETI ('LEFT/MAJOR/TYPE.',3) + CALL AGSETF ('LEFT/MAJOR/BASE.',2.) + CALL AGSETI ('LEFT/NUMERIC/TYPE.',3) + CALL AGSETI ('LEFT/MINOR/SPACING.',4) +c CALL AGSETI ('LEFT/MINOR/PATTERN.',125252B) +C +C Compute secondary control parameters. +C + CALL AGSTUP (XYCD(1),1,0,113,2,XYCD(2),1,0,113,2) +C +C Draw the background. +C + CALL AGBACK +C +C Draw the curve twice to make it darker. +C + CALL AGCURV (XYCD(1),2,XYCD(2),2,113,1) + CALL AGCURV (XYCD(1),2,XYCD(2),2,113,1) +C +C Draw a boundary around the edge of the plotter frame. +C +c CALL BNDARY +C +C Advance the frame. +C +c CALL FRAME +C +c STOP +C +C Format. +C +c1001 FORMAT (14E5.0) +C + END +C 1.8 2.1 2.7 1.6 4.2 1.5 5.7 1.9 6.3 2.9 6.5 4.7 6.0 6.7 +C 5.6 8.6 5.4 10.7 5.6 13.1 4.8 11.2 3.7 9.7 1E36 1E36 7.0 8.2 +C 7.7 10.6 8.2 12.6 8.2 14.3 8.0 15.3 7.7 15.6 7.5 15.1 7.4 14.0 +C 7.6 12.3 7.7 10.7 7.9 8.9 8.2 7.3 8.5 4.6 8.5 7.3 8.6 9.3 +C 8.8 10.2 9.1 10.5 9.4 10.1 9.6 9.1 9.9 7.8 10.3 6.9 11.1 7.0 +C 11.7 7.8 12.0 8.6 12.3 10.0 12.5 11.5 12.4 12.7 12.2 13.0 11.9 12.6 +C 11.7 11.7 11.6 10.5 11.7 9.3 12.0 8.6 12.5 8.6 13.0 9.0 13.8 10.1 +C 14.3 11.1 1E36 1E36 18.5 23.4 18.2 23.5 17.8 23.2 17.2 22.6 16.8 21.8 +C 16.0 20.2 15.8 19.5 16.0 19.3 16.6 19.6 17.8 20.6 17.3 19.1 16.9 17.3 +C 16.6 16.0 16.6 14.5 16.8 13.7 17.1 13.1 17.8 13.2 18.4 14.0 19.2 15.5 +C 19.8 16.8 20.3 18.0 20.9 20.1 21.1 18.9 21.1 17.4 21.1 18.9 21.2 19.7 +C 1.5 20.5 21.8 20.8 22.0 20.4 22.1 19.6 22.3 18.7 22.6 18.4 23.1 18.9 +C 23.6 20.0 24.1 21.7 24.7 22.9 25.3 23.9 24.7 22.9 24.4 21.6 24.4 20.6 +C 24.7 20.2 25.2 20.7 25.6 21.5 26.0 22.9 26.4 24.5 26.7 25.9 26.8 27.9 +C 26.6 30.0 26.4 30.3 26.2 30.0 25.7 28.0 25.5 26.1 25.3 24.9 25.3 23.9 +C 25.4 22.9 25.9 22.5 26.6 22.4 27.4 23.1 28.2 24.0 29.0 25.0 30.1 26.4 +C 1E36 1E36 diff --git a/sys/gio/ncarutil/tests/preal.x b/sys/gio/ncarutil/tests/preal.x new file mode 100644 index 00000000..79d33218 --- /dev/null +++ b/sys/gio/ncarutil/tests/preal.x @@ -0,0 +1,12 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +procedure preal (tval, rval) + +char tval[ARB] +real rval + +begin + call eprintf ("%s %.4f\n") + call pargstr (tval) + call pargr (rval) +end diff --git a/sys/gio/ncarutil/tests/pwrity.x b/sys/gio/ncarutil/tests/pwrity.x new file mode 100644 index 00000000..3b5c1437 --- /dev/null +++ b/sys/gio/ncarutil/tests/pwrity.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +# Test NCAR routines PWRITY + +procedure t_pwrity() + +char device[SZ_FNAME] +int error_code, wkid +int gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tpwry (error_code) + + if (error_code == 0) + call printf ("Test successful\n") + else + call printf ("Test was not successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/pwrityt.f b/sys/gio/ncarutil/tests/pwrityt.f new file mode 100644 index 00000000..5b033933 --- /dev/null +++ b/sys/gio/ncarutil/tests/pwrityt.f @@ -0,0 +1,90 @@ + SUBROUTINE TPWRY (IERROR) +C +C LATEST REVISION JULY 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C ENTRY PWRITY OF PWRITY AND +C TO TEST PWRITY ON A SIMPLE PROBLEM +C +C USAGE CALL TPWRY (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C PWRITY TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS WRITTEN TO UNIT 6. +C IN ADDITION, ONE FRAME CONTAINING +C CHARACTER STRING PLOTS IS PRODUCED ON THE +C MACHINE GRAPHICS DEVICE. IN ORDER TO +C DETERMINE WHETHER THE TEST WAS SUCCESSFUL, +C IT IS NECESSARY TO EXAMINE THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY PWRITY +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM TPWRY CALLS PWRITY TO PLOT VARIOUS CHARACTER +C STRINGS USING DIFFERENT PARAMETERS. +C +C PORTABILITY ANSI FORTRAN 77 +C +C +C INITIALIZE THE ERROR PARAMETER. +C + IERROR = 0 +C +C DEFINE NORMALIZATION TRANS 1 AND LOG SCALING +C + CALL GSVP (1, 0.0, 1.0, 0.0, 1.0) + CALL GSWN (1, 1.0, 1024.0, 1.0, 1024.0) + CALL GSELNT (1) + CALL SETUSV ('LS',1) +C +C LABEL FRAME +C + CALL PWRITY(512.0,950.0, + 1 'DEMONSTRATION PLOT FOR PWRITY', + 2 29,2,0,0) +C +C TEST PWRITY FOR DIFFERENT SIZE CHARACTERS. +C + CALL PWRITY (10.0,900.0,'SIZE TEST',9,0,0,-1) + CALL PWRITY (10.0,850.0,'SIZE TEST',9,1,0,-1) + CALL PWRITY (10.0,775.0,'SIZE TEST',9,2,0,-1) + CALL PWRITY (10.0,675.0,'SIZE TEST',9,3,0,-1) + CALL PWRITY (10.0,525.0,'SIZE TEST',9,4,0,-1) + CALL PWRITY (10.0,375.0,'SIZE TEST',9,5,0,-1) +C +C TEST PWRITY FOR DIFFERENT CHARACTER ORIENTATIONS. +C + CALL PWRITY (600.0,600.0,'THETA TEST',10,2,0*90,-1) + CALL PWRITY (600.0,600.0,'THETA TEST',10,2,1*90,-1) + CALL PWRITY (600.0,600.0,'THETA TEST',10,2,2*90,-1) + CALL PWRITY (600.0,600.0,'THETA TEST',10,2,3*90,-1) +C +C TEST CENTERING OPTIONS FOR PWRITY. +C + CALL PWRITY (512.0,160.0,'CENTR TEST',10,2,0,0) + CALL PWRITY (512.0,85.0,'CENTR TEST',10,2,0,-1) + CALL PWRITY (512.0,235.0,'CENTR TEST',10,2,0,1) +c +c CALL NEWFM +C +c WRITE (6,1001) + RETURN +C +c 1001 FORMAT (' PWRITY TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/pwrzit.f b/sys/gio/ncarutil/tests/pwrzit.f new file mode 100644 index 00000000..7c96e926 --- /dev/null +++ b/sys/gio/ncarutil/tests/pwrzit.f @@ -0,0 +1,132 @@ + SUBROUTINE TPWRZI (IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C PWRZI IN CONJUNCTION WITH ISOSRF +C +C USAGE CALL TPWRZI (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C PWRZI TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, ONE FRAME CONTAINING THE SAMPLE +C PLOT IS PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. IN ORDER TO DETERMINE IF THE TEST +C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY PWRZI, ISOSRF +C FILES +C +C +C LANGUAGE FORTRAN +C +C ALGORITHM A FUNCTION OF THREE VARIABLES IS DEFINED, AND +C VALUES OF THE FUNCTION ON A THREE DIMENSIONAL +C RECTANGULAR GRID ARE STORED IN AN ARRAY. THIS +C SUBROUTINE THEN CALLS ISOSRF TO DRAW AN +C ISO-VALUED SURFACE PLOT OF THE FUNCTION, +C THEN PWRZI IS CALLED THREE TIMES TO +C LABEL THE FRONT, SIDE, AND BACK OF THE +C PICTURE. +C +C PORTABILITY ANSI FORTRAN 77 +C +C + DIMENSION T(21,31,19),SLAB(33,33),EYE(3) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY +C DEFINE THE CENTER OF THE TITLE STRING. +C + DATA TX/0.4375/, TY/0.9667/ +C + DATA NU,NV,NW/21,31,19/ + DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./ + DATA TISO/0./ + DATA MUVWP2/33/ + DATA IFLAG/-7/ +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 1 +C +C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED +C + JCENT1 = FLOAT(NV)*.5-RBIG1*.5 + JCENT2 = FLOAT(NV)*.5+RBIG2*.5 + DO 30 I=1,NU + FIMID = I-NU/2 + DO 20 J=1,NV + FJMID1 = J-JCENT1 + FJMID2 = J-JCENT2 + DO 10 K=1,NW + FKMID = K-NW/2 + F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1)) + F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1)) + FIP1 = (1.-F1)*FIMID + FIP2 = (1.-F2)*FIMID + FJP1 = (1.-F1)*FJMID1 + FJP2 = (1.-F2)*FJMID2 + FKP1 = (1.-F1)*FKMID + FKP2 = (1.-F2)*FKMID + T(I,J,K) = AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1- + 1 RSML1*RSML1, + 2 FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2) + 10 CONTINUE + 20 CONTINUE + 30 CONTINUE +C +C DEFINE EYE POSITION +C + EYE(1) = 100. + EYE(2) = 150. + EYE(3) = 125. +C +C SELECT NORMALIZATION TRANS NUMBER 0 +C + CALL GSELNT (0) +C +C +C LABEL THE PLOT +C + CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR PWRZI',2,0,0) +C +C TEST ISOSRF WITH SUBARRAY OF T +C + MU = NU/2 + MV = NV/2 + MW = NW/2 + MUVWP2 = MAX0(MU,MV,MW)+2 + CALL ISOSRF (T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO, + 1 IFLAG) + ISIZE = 35 + CALL PWRZI (5.,16.,.5,'FRONT',5,ISIZE,-1,3,0) + CALL PWRZI (11.,7.5,.5,'SIDE',4,ISIZE,2,-1,0) + CALL PWRZI (5.,1.,5.,' BACK BACK BACK BACK BACK',25,ISIZE,-1,3,0) + CALL SETUSV ('XF',10) + CALL SETUSV ('YF',10) + CALL NEWFM + IERROR = 0 +C +c WRITE (6,1001) + RETURN +C +C +c1001 FORMAT (' PWRZI TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/pwrzs.x b/sys/gio/ncarutil/tests/pwrzs.x new file mode 100644 index 00000000..f2eeec96 --- /dev/null +++ b/sys/gio/ncarutil/tests/pwrzs.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +# Test NCAR routines PWRZS + +procedure t_przs() + +char device[SZ_FNAME] +int error_code, wkid +int gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tpwrzs (error_code) + + if (error_code == 0) + call printf ("Test successful\n") + else + call printf ("Test was not successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/pwrzst.f b/sys/gio/ncarutil/tests/pwrzst.f new file mode 100644 index 00000000..4067ed86 --- /dev/null +++ b/sys/gio/ncarutil/tests/pwrzst.f @@ -0,0 +1,127 @@ + SUBROUTINE TPWRZS (IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C PWRZS IN CONJUNCTION WITH SRFACE. +C +C USAGE CALL TPWRZS (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST WAS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST WAS SUCCESSFUL, THE MESSAGE +C +C PWRZS TEST SUCCESSFUL . . . SEE PLOT +C TO VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C IN ADDITION, ONE FRAME CONTAINING THE SAMPLE +C PLOT IS PRODUCED ON THE MACHINE GRAPHICS +C DEVICE. IN ORDER TO DETERMINE IF THE TEST +C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE +C THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY PWRZS, SRFACE +C FILES +C +C LANGUAGE FORTRAN +C +C ALGORITHM A FUNCTION OF TWO VARIABLES IS DEFINED, AND +C VALUES OF THE FUNCTION ON A TWO DIMENSIONAL +C RECTANGULAR GRID ARE STORED IN AN ARRAY. THIS +C SUBROUTINE CALLS SRFACE TO DRAW A SURFACE +C REPRESENTATION OF THE ARRAY VALUES, AND THEN +C PWRZS IS CALLED THREE TIMES TO LABEL THE +C FRONT, SIDE, AND BACK OF THE PICTURE. +C +C PORTABILITY ANSI FORTRAN 77 +C +C + DIMENSION Z(20,30) ,X(20) ,Y(30) ,MM(20,30,2), + 1 S(6) +C +C LOAD THE SRFACE COMMON BLOCK, NEEDED TO SURPRESS NEWFM CALL +C + COMMON /SRFIP1/ IFR ,ISTP ,IROTS ,IDRX , + 1 IDRY ,IDRZ ,IUPPER ,ISKIRT , + 2 NCLA ,THETA ,HSKIRT ,CHI , + 3 CLO ,CINC ,ISPVAL +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND +C TY DEFINE THE CENTER OF THE TITLE STRING. +C + DATA TX/0.4375/, TY/0.9667/ +C +C SPECIFY GRID LOOP INDICES, AND LINE OF SIGHT +C + DATA M/20/, N/30/ + DATA S/4.,5.,3.,0.,0.,0./ +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 1 +C +C DEFINE FUNCTION VALUES AND STORE IN Z +C + DO 10 I=1,M + X(I) = -1.+FLOAT(I-1)/FLOAT(M-1)*2. + 10 CONTINUE + DO 20 J=1,N + Y(J) = -1.+FLOAT(J-1)/FLOAT(N-1)*2. + 20 CONTINUE + DO 40 J=1,N + DO 30 I=1,M + Z(I,J) = EXP(-2.*SQRT(X(I)**2+Y(J)**2)) + 30 CONTINUE + 40 CONTINUE +C +C SET SRFACE PARAMETERS TO SURPRESS FRAME CALL AND DRAW CONTOURS + call srfabd +C + IFR = 0 + IDRZ = 1 +C +C SELECT NORMALIZATION TRANS NUMBER 0 +C + CALL GSELNT (0) +C +C LABEL THE PLOT +C + CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR PWRZS',2,0,0) +C +C DRAW SURFACE PLOT +C + CALL SRFACE (X,Y,Z,MM,M,M,N,S,0.) +C +C PUT PWRZS LABELS ON PICTURE +C + ISIZE = 35 + CALL PWRZS (0.,1.1,0.,'FRONT',5,ISIZE,-1,3,0) + CALL PWRZS (1.1,0.,0.,'SIDE',4,ISIZE,2,-1,0) + CALL PWRZS (0.,-1.1,.2,' BACK BACK BACK BACK BACK',25,ISIZE,-1, + 1 3,0) +c CALL NEWFM +C + IERROR = 0 +c WRITE (6,1001) +C +C RESTORE SRFACE PARAMETERS TO DEFAULT +C + IFR = 1 + IDRZ = 0 +C + RETURN +C +C +c1001 FORMAT (' PWRZS TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/pwrztt.f b/sys/gio/ncarutil/tests/pwrztt.f new file mode 100644 index 00000000..dcf43638 --- /dev/null +++ b/sys/gio/ncarutil/tests/pwrztt.f @@ -0,0 +1,116 @@ + SUBROUTINE TPWRZT (IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C PWRZT IN CONJUNCTION WITH THREED. +C +C USAGE CALL TPWRZT (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST IS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C PWRZT TEST SUCCESSFUL . . . SEE PLOT +C TO VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C +C IN ADDITION, ONE FRAME CONTAINING THE +C CHARACTER PLOT IS PRODUCED ON THE +C MACHINE GRAPHICS DEVICE. TO DETERMINE +C IF THE TEST IS SUCCESSFUL, IT IS NECESSARY +C TO EXAMINE THIS PLOT. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY PWRZT, THREED +C FILES +C +C +C LANGUAGE FORTRAN +C +C ALGORITHM TPWRZT CALLS SUBROUTINES SET3 AND LINE3 FROM +C THE ULIB THREED PACKAGE TO ESTABLISH THE +C THREE SPACE-TO-TWO SPACE TRANSFORMATION +C AND TO DRAW AXIS LINES. TPWRZT NEXT CALLS +C SUBROUTINE PWRZT FROM THE ULIB THREED +C PACKAGE TO LABEL THE AXES FOR A THREE SPACE +C PLOT. +C +C PORTABILITY ANSI FORTRAN 77 +C +C +C EYE CONTAINS THE (U,V,Z) COORDINATE OF THE EYE POSITION +C + REAL EYE(3) + DATA EYE(1), EYE(2), EYE(3) /3.5, 3.0, 5.0/ +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 1 +C +C SELECT NORMALIZATION TRANS NUMBER 0 +C + CALL GSELNT (0) +C +C SUBROUTINE SET3 ESTABLISHES THE MAPPING OF THREE SPACE COORDINATES +C ONTO THE GRAPHICS DEVICE COORDINATE SYSTEM. +C + CALL SET3 (.1,.9,.1,.9,0.,1.,0.,1.,0.,1.,EYE) +C +C THE FOLLOWING THREE CALLS TO LINE3 DRAW THE THREE SPACE AXES +C + CALL LINE3 (0.,0.,0.,0.,0.,1.) + CALL LINE3 (0.,0.,0.,0.,1.,0.) + CALL LINE3 (0.,0.,0.,1.,0.,0.) +C +C SUBROUTINE PWRZ IS USED TO LABEL EACH OF THE AXES AND THE PLOT +C ON INPUT TO PWRZ, +C THE FIRST THREE PARAMETERS AND ICNT DETERMINE THE POSITION OF THE +C CHARACTER STRING. +C ISIZE DETERMINES THE CHARACTER SIZE. +C LINE AND ITOP DETERMINE THE DIRECTION AND PLANE OF THE CHARACTERS. +C +C + ICNT = 0 + ISIZE = 30 + LINE = 2 + ITOP = 3 + CALL PWRZT (0.,.5,.1,'V-AXIS',6,ISIZE,LINE,ITOP,ICNT) +C + LINE = -1 + ITOP = 3 + CALL PWRZT (.5,0.,.1,'U-AXIS',6,ISIZE,LINE,ITOP,ICNT) +C + LINE = 3 + ITOP = -2 + CALL PWRZT (0.,.1,.5,'Z-AXIS',6,ISIZE,LINE,ITOP,ICNT) +C + LINE = 2 + ITOP = -1 + ISIZE = 30 + ICNT = -1 + CALL PWRZT (.5,.2,0.,'DEMONSTRATION OF PWRZT WITH THREED', + 1 34,ISIZE,LINE,ITOP,ICNT) +C +C A CALL TO NEWFM INDICATES THAT THE PICTURE IS COMPLETE +C + CALL NEWFM +C + IERROR = 0 +c WRITE (6,1001) +C + RETURN +C +C +C +c1001 FORMAT (' PWRZT TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/srf.com b/sys/gio/ncarutil/tests/srf.com new file mode 100644 index 00000000..d1b4288c --- /dev/null +++ b/sys/gio/ncarutil/tests/srf.com @@ -0,0 +1,4 @@ +int ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, ncla, hskirt, ispval +real theta, chi, clo, cinc +common /srfip1/ ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, + ncla, theta, hskirt, chi, clo, cinc, ispval diff --git a/sys/gio/ncarutil/tests/srfacet.f b/sys/gio/ncarutil/tests/srfacet.f new file mode 100644 index 00000000..4e5bad00 --- /dev/null +++ b/sys/gio/ncarutil/tests/srfacet.f @@ -0,0 +1,150 @@ + SUBROUTINE TSRFAC (nplot, IERROR) +C +C LATEST REVISION MARCH 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C SRFACE AND TO TEST SRFACE ON A SINGLE +C PROBLEM +C +C USAGE CALL TSRFAC (IERROR) +C +C ARGUMENTS +c +noao: additional input parameter +c nplot +c = 1, EZSRF is demonstrated +c = 2, SRFACE is demonstrated +c +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C = 0, IF THE TEST IS SUCCESSFUL, +C = 1, OTHERWISE +C +C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE +C +C SRFACE TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C +C IS PRINTED ON UNIT 6. +C +C IN ADDITION, TWO FRAMES CONTAINING THE +C SURFACE PLOT ARE PRODUCED ON THE MACHINE +C GRAPHICS DEVICE. IN ORDER TO DETERMINE +C IF THE TEST WAS SUCCESSFUL, IT IS +C NECESSARY TO EXAMINE THESE PLOTS. +C +C PRECISION SINGLE +C +C REQUIRED LIBRARY SRFACE +C FILES +C +C LANGUAGE FORTRAN +C +C HISTORY FIRST WRITTEN IN APRIL 1979, CONVERTED TO +C FORTRAN 77 AND GKS IN MARCH 1984. +C +C ALGORITHM THE FUNCTION +C +C Z(X,Y) = .25*(X + Y + 1./((X-.1)**2+Y**2+.09) +C - 1./((X+.1)**2+Y**2+.09)) +C +C IS EVALUATED FOR +C X = -1. TO 1. IN INCREMENTS OF .1 AND +C Y = -1.2 TO 1.2 IN INCREMENTS OF .1. +C TSRFAC CALLS SUBROUTINES EZSRFC AND SRFACE +C ONCE. EACH CALL PRODUCES A SURFACE PLOT +C OF THE ARRAY Z. +C +C PORTABILITY ANSI FORTRAN 77 +C +C XX CONTAINS THE X-DIRECTION COORDINATE VALUES FOR Z(X,Y), YY CONTAINS +C THE Y-DIRECTION COORDINATE VALUES FOR Z(X,Y), Z CONTAINS THE FUNCTION +C VALUES, S CONTAINS VALUES FOR THE LINE OF SIGHT FOR ENTRY SRFACE, +C WORK IS A WORK ARRAY, ANGH CONTAINS THE ANGLE IN DEGREES IN THE X-Y +C PLANE TO THE LINE OF SIGHT, ANGV CONTAINS THE ANGLE IN DEGREES FROM +C THE X-Y PLANE TO THE LINE OF SIGHT. +C + REAL XX(21) ,YY(25) ,Z(21,25) ,S(6) , + 1 WORK(1096) +C + DATA S(1), S(2), S(3), S(4), S(5), S(6)/ + 1 -8.0, -6.0, 3.0, 0.0, 0.0, 0.0/ +C + DATA ANGH/45./, ANGV/15./ +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE COORDINATES RANGE FROM 0. TO 1., THE VALUES CX AND CY +C DEFINE THE CENTER OF THE TITLE STRING. +C + DATA CX/.405/, CY/.97/ +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 0 +C +C FILL XX AND YY COORDINATE ARRAYS AND Z FUNCTION VALUE ARRAY +C + DO 20 I=1,21 + X = .1*FLOAT(I-11) + XX(I) = X + DO 10 J=1,25 + Y = .1*FLOAT(J-13) + YY(J) = Y + Z(I,J) = (X+Y+1./((X-.1)**2+Y**2+.09)- + 1 1./((X+.1)**2+Y**2+.09))*.25 + 10 CONTINUE + 20 CONTINUE +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT(0) +C +C EZSRFC DEMO +C +C LABEL THE PLOT FOR ENTRY EZSRFC +C +C SET TEXT ALIGNMENT TO CENTER THE STRING AT THE STRING CENTER +C AND IN THE VERTICAL CENTER +C + CALL GSTXAL(2,3) +C +C SET CHARACTER HEIGHT +C + CALL GSCHH(.016) +C +C PLOT CHARACTERS +C + if (nplot .eq. 1) then + CALL GTX(CX,CY,'DEMONSTRATION PLOT FOR EZSRFC ENTRY OF SRFACE') + CALL EZSRFC (Z,21,25,ANGH,ANGV,WORK) + endif +C +C +C SRFACE DEMO +C +C LABEL THE PLOT FOR ENTRY SRFACE +C +C SET TEXT ALIGNMENT TO CENTER THE STRING AT THE STRING CENTER +C AND IN THE VERTICAL CENTER +C + CALL GSTXAL(2,3) +C +C SET CHARACTER HEIGHT +C + CALL GSCHH(.016) +C +C PLOT CHARACTERS +C + if (nplot .eq. 2) then + CALL GTX(CX,CY,'DEMONSTRATION PLOT FOR SRFACE ENTRY OF SRFACE') + CALL SRFACE (XX,YY,Z,WORK,21,21,25,S,0.) + endif +C +c WRITE (6,1001) +C + RETURN +C +C1001 FORMAT (' SRFACE TEST SUCCESSFUL',24X, +C 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/srftest.x b/sys/gio/ncarutil/tests/srftest.x new file mode 100644 index 00000000..cf1496b7 --- /dev/null +++ b/sys/gio/ncarutil/tests/srftest.x @@ -0,0 +1,68 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +procedure srf_test() + +char temp[SZ_LINE] +real z[20,30], x[20], y[30], s[6] +int mm[20,30,2] +real tx, ty +int i, j, m, n, isize +real xt, yt, dum + +int ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, ncla, hskirt, ispval +real theta, chi, clo, cinc +common /srfip1/ ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, + ncla, theta, hskirt, chi, clo, cinc, ispval + +begin + # Some initialization that was originally in data statements: + tx = 0.4375 + ty = 0.9667 + m = 20 + n = 30 + s[1] = 4.0 + s[2] = 5.0 + s[3] = 3.0 + s[4] = 0.0 + s[5] = 0.0 + s[6] = 0.0 + + # Define function values and store in z + DO I=1,M + X(I) = -1.+FLOAT(I-1)/FLOAT(M-1)*2. + + DO J=1,N + Y(J) = -1.+FLOAT(J-1)/FLOAT(N-1)*2. + + DO J=1,N { + DO I=1,M + Z(I,J) = EXP(-2.*SQRT(X(I)**2+Y(J)**2)) + } + + # Initialize block data before changing parameters. + call srfabd + + IFR = 0 + IDRZ = 1 + + CALL GSELNT (0) + call f77pak ("DEMONSTRATION PLOT FOR PWRZS", temp, SZ_LINE) + CALL WTSTR (TX,TY,temp,2,0,0) + + CALL SRFACE (X,Y,Z,MM,M,M,N,S,0.) +# +# PUT PWRZS LABELS ON PICTURE +# + ISIZE = 35 + call f77pak ("FRONT", temp, SZ_LINE) + CALL PWRZS (0.,1.1,0.,temp,5,ISIZE,-1,3,0) + call f77pak ("SIDE", temp, SZ_LINE) + CALL PWRZS (1.1,0.,0.,temp,4,ISIZE,2,-1,0) + call f77pak (" BACK BACK BACK BACK BACK", temp, SZ_LINE) + CALL PWRZS (0.,-1.1,.2,temp,25,ISIZE,-1,3,0) +# +# RESTORE SRFACE PARAMETERS TO DEFAULT +# + IFR = 1 + IDRZ = 0 +end diff --git a/sys/gio/ncarutil/tests/srftestd.x b/sys/gio/ncarutil/tests/srftestd.x new file mode 100644 index 00000000..8c22ff92 --- /dev/null +++ b/sys/gio/ncarutil/tests/srftestd.x @@ -0,0 +1,29 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +task srftest = t_srftest + +define DUMMY 6 + +# Rewrite of pwrzs.t.f in spp to check things out. + +procedure t_srftest() + +char device[SZ_FNAME] +int error_code, wkid +int gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call srf_test() + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/strmln.x b/sys/gio/ncarutil/tests/strmln.x new file mode 100644 index 00000000..2835d211 --- /dev/null +++ b/sys/gio/ncarutil/tests/strmln.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routine STRMLN + +procedure t_strmln() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tstrml (error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/strmlnt.f b/sys/gio/ncarutil/tests/strmlnt.f new file mode 100644 index 00000000..f2b40c69 --- /dev/null +++ b/sys/gio/ncarutil/tests/strmlnt.f @@ -0,0 +1,101 @@ + SUBROUTINE TSTRML (IERROR) +C +C LATEST REVISION JUNE 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C ROUTINE STRMLN. +C +C USAGE CALL TSTRML (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C =0 IF THERE IS A NORMAL EXIT FROM THE +C ROUTINE STRMLN. +C =1 OTHERWISE +C +C I/O IF THERE IS A NORMAL EXIT FROM THE ROUTINE +C STRMLN THE MESSAGE +C STRMLN TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C IS PRINTED. +C +C PRECISION SINGLE +C +C +C LANGUAGE FORTRAN +C +C ALGORITHM ROUTINE TSTRML CALLS ROUTINE STRMLN TO +C PRODUCE A PLOT REPRESENTING THE FLOW AND +C MAGNITUDE OF A VECTOR FIELD. +C +C PORTABILITY FORTRAN77 +C +C +C + REAL U(21,25) ,V(21,25) ,WRK(1050) +C +C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE +C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY +C DEFINE THE CENTER OF THE TITLE STRING. +C + DATA TX/.5/,TY/.9765/ +C +C SET DIMENSIONS +C + DATA NH,NV/21,25/ +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 1 +C +C SPECIFY HORIZONTAL AND VERTICAL VECTOR COMPONENTS U AND V ON +C THE RECTANGULAR GRID +C + TPIMX = 2.*3.14/FLOAT(NH) + TPJMX = 2.*3.14/FLOAT(NV) + DO 20 J=1,NV + DO 10 I=1,NH + U(I,J) = SIN(TPIMX*(FLOAT(I)-1.)) + V(I,J) = SIN(TPJMX*(FLOAT(J)-1.)) + 10 CONTINUE + 20 CONTINUE +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT (0) +C +C CALL WTSTR FOR STRMLN PLOT TITLE +C + CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR ROUTINE STRMLN',2, + 1 0,0) +C +C DEFINE NORMALIZATION TRANSFORMATION 1, AND SET UP LOG SCALING +C + CALL GSVP ( 1, 0.1, 0.9, 0.1, 0.9 ) + CALL GSWN ( 1, 1.0, 21., 1.0, 25. ) + CALL SETUSV ( 'LS' , 1 ) +C +C SELECT NORMALIZATION TRANSFORMATION 1 +C + CALL GSELNT (1) +C +C DRAW PERIMETER +C +c CALL PERIM(1,0,1,0) +C +C CALL STRMLN FOR VECTOR FIELD STREAMLINES PLOT +C + CALL STRMLN (U,V,WRK,NH,NH,NV,0,IER) +C +c CALL NEWFM +C + IERROR = 0 +c WRITE (6,1001) + RETURN +C +c1001 FORMAT (' STRMLN TEST SUCCESSFUL',24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/surface.x b/sys/gio/ncarutil/tests/surface.x new file mode 100644 index 00000000..07b25e9a --- /dev/null +++ b/sys/gio/ncarutil/tests/surface.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routines SRFACE. + +procedure t_surface() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tsrfac (2, error_code) + if (error_code == 0) + call printf ("Test of SRFACE successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/threed.x b/sys/gio/ncarutil/tests/threed.x new file mode 100644 index 00000000..a22d51da --- /dev/null +++ b/sys/gio/ncarutil/tests/threed.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routine THREED + +procedure t_threed() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tthree (error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/threed2.x b/sys/gio/ncarutil/tests/threed2.x new file mode 100644 index 00000000..224fd2c3 --- /dev/null +++ b/sys/gio/ncarutil/tests/threed2.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routine THREED with extra test program tst3d2 + +procedure t_threed2() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tst3d2 () + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/threed2t.f b/sys/gio/ncarutil/tests/threed2t.f new file mode 100644 index 00000000..baaa8f78 --- /dev/null +++ b/sys/gio/ncarutil/tests/threed2t.f @@ -0,0 +1,26 @@ + subroutine tst3d2 () + real eye(3) + dimension u(50), v(50), w(50) + data eye /5., -10., 4./ + isiz = 36 + xs = 90. / 1024. + xe = 1010. / 1024. + ys = 90. / 1024. + ye = 1010. / 1024. + call tick43 (24, 16, 24, 16, 24, 16) +c call set3 (90, 1010, 90, 1010, 0., 2., -1., 1., 0., 1., eye) + call set3 (xs, xe, ys, ye, 0., 2., -1., 1., 0., 1., eye) + do 1 i = 1, 50 + u(i) = float(i) * .04 + v(i) = sin (u(i) * 6.) * float (80 - i) / 80. + w(i) = .5 + sin (u(i) *3.141592) * .5 + 1 continue + call perim3 (2,5,1,5,1,0.) + call perim3 (2,5,1,5,2,-1.) + call perim3 (2,5,2,5,3,0.) + call pwrzt (2.1, -1., 0., 3hU->, 3, isiz, 1,3,-1) + call pwrzt (0., 1.1, 0., 3hV->, 3, isiz, 2,3,0) + call pwrzt (0., -1., 1.1, 2hW , 2, isiz, 3, -1, 0) + call fence3 (u, v, w, 50, 3, 0.) + end + diff --git a/sys/gio/ncarutil/tests/threedt.f b/sys/gio/ncarutil/tests/threedt.f new file mode 100644 index 00000000..0cb6532d --- /dev/null +++ b/sys/gio/ncarutil/tests/threedt.f @@ -0,0 +1,129 @@ + SUBROUTINE TTHREE (IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C THE ROUTINE THREED. +C +C USAGE CALL TTHREE (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C =0 IF THERE IS A NORMAL EXIT FROM THE +C ROUTINE THREED. +C =1 OTHERWISE +C +C I/O IF THERE IS A NORMAL EXIT FROM THE ROUTINE +C THREED THE MESSAGE +C THREED TEST SUCCESSFUL . . . SEE PLOT TO +C VERIFY PERFORMANCE +C IS PRINTED. +C +C PRECISION SINGLE +C +C LANGUAGE FORTRAN +C +C HISTORY ORIGINALLY WRITTEN NOVEMBER 1976 +C CONVERTED TO GKS AND FORTRAN 77 JULY 1984 +C +C ALGORITHM ROUTINE TTHREE CALLS SET3 TO ESTABLISH A +C MAPPING BETWEEN THE PLOTTER ADDRESSES AND +C THE USER'S VOLUME, AND TO INDICATE THE +C COORDINATES OF THE EYE POSITION FROM +C WHICH THE LINES TO BE DRAWN ARE VIEWED. +C NEXT, THE VOLUME PERIMETERS AND ASSOCIATED +C TICK MARKS ARE DRAWN BY CALLS TO PERIM3. +C THEN THE LINES ARE DRAWN. THESE ARE +C CERTAIN LATITUDES AND LONGITUDES OF A +C SPHERE. +C +C PORTABILITY ANSI FORTRAN 77 +C +C +C +C + REAL EYE(3),X(31),Y(31),Z(31) +C +C SPECIFY ARGUMENT VALUES TO BE USED BY ROUTINE SET3. ON AN +C ABSTRACT PLOTTER WITH AN ADDRESS RANGE OF 0. TO 1. IN EACH +C COORDINATE DIRECTION, THE VALUES RXA, RXB, RYA, AND RYB +C DEFINE THE PORTION OF THE ADDRESS SPACE TO BE USED IN MAKING +C THE PLOT. UC, UD, VC, VD, WC, WD DEFINE A VOLUME IN USER +C COORDINATES WHICH IS TO BE MAPPED ONTO THE PORTION OF THE +C VIEWING SURFACE AS SPECIFIED BY RXA, RXB, RYA, AND RYB. +C + DATA RXA/0.097656/, RXB/0.90236/, RYA/0.097656/, RYB/0.90236/ + DATA UC/-1./, UD/1./, VC/-1./, VD/1./, WC/-1./, WD/1./ + DATA EYE(1),EYE(2),EYE(3)/10.,6.,3./ + DATA TX/0.4374/, TY/0.9570/ +C +C DEFINE PI + DATA PI/3.1415926535898/ +C +C +C SELECT NORMALIZATION TRANSFORMATION 0 +C + CALL GSELNT (0) +C +C CALL SET3 TO ESTABLISH A MAPPING BETWEEN THE PLOTTER ADDRESSES +C AND THE USER'S VOLUME, AND TO INDICATE THE COORDINATES OF THE +C EYE POSITION FROM WHICH THE LINES TO BE DRAWN ARE VIEWED. +C + CALL SET3(RXA,RXB,RYA,RYB,UC,UD,VC,VD,WC,WD,EYE) +C +C CALL PERIM3 TO DRAW PERIMETER LINES AND TICK MARKS +C + CALL PERIM3(2,5,1,10,1,-1.) + CALL PERIM3(4,2,1,1,2,-1.) + CALL PERIM3(2,10,4,5,3,-1.) +C +C DEFINE AND DRAW LATITUDINAL LINES ON THE SPHERE OF RADIUS ONE +C HAVING CENTER (0.,0.,0.) +C + DO 10 J=1,18 + THETA = FLOAT(J)*PI/9. + CT = COS(THETA) + ST = SIN(THETA) + DO 20 K=1,31 + PHI = FLOAT(K-16)*PI/30. + Z(K) = SIN(PHI) + CP = COS(PHI) + X(K) = CT*CP + Y(K) = ST*CP + 20 CONTINUE + CALL CURVE3(X,Y,Z,31) + 10 CONTINUE +C +C DEFINE AND DRAW LONGITUDINAL LINES ON THE SPHERE OF RADIUS ONE +C HAVING CENTER (0.,0.,0.) +C + DO 30 K=1,5 + PHI = FLOAT(K-3)*PI/6. + SP = SIN(PHI) + CP = COS(PHI) + DO 40 J=1,31 + TUETA = FLOAT(J-1)*PI/15. + X(J) = COS(TUETA)*CP + Y(J) = SIN(TUETA)*CP + Z(J) = SP + 40 CONTINUE + CALL CURVE3(X,Y,Z,31) + 30 CONTINUE +C +C CALL WTSTR FOR THREED PLOT TITLE +C + CALL WTSTR(TX,TY,'DEMONSTRATION PLOT FOR ROUTINE THREED',2,0,0) + call pwrzt (1.,0.,-1.,'DEMONSTRATION PLOT FOR ROUTINE THREED', 37, + * 2, 2, 3, 0) +C +c CALL NEWFM +C + IERROR = 0 +c WRITE(6,1001) + RETURN +C +c1001 FORMAT(' THREED TEST SUCCESSFUL', 24X, +c 1 'SEE PLOT TO VERIFY PERFORMANCE') + END diff --git a/sys/gio/ncarutil/tests/velvctt.f b/sys/gio/ncarutil/tests/velvctt.f new file mode 100644 index 00000000..36e22d28 --- /dev/null +++ b/sys/gio/ncarutil/tests/velvctt.f @@ -0,0 +1,126 @@ + SUBROUTINE TVELVC (nplot, IERROR) +C +C LATEST REVISION JULY, 1984 +C +C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF +C SUBROUTINES VELVCT AND EZVEC. +C +C USAGE CALL TVELVC (IERROR) +C +C ARGUMENTS +C +C ON OUTPUT IERROR +C AN INTEGER VARIABLE +C =0 IF THERE IS A NORMAL EXIT FROM THE +C ROUTINES VELVCT AND EZVEC +C =1 OTHERWISE +C +C I/O IF THERE IS A NORMAL EXIT FROM THE ROUTINES +C VELVCT AND EZVEC THE MESSAGE +C VELVCT TEST SUCCESSFUL . . . SEE PLOTS TO +C VERIFY PERFORMANCE +C IS PRINTED. +C +C PRECISION SINGLE +C +C LANGUAGE FORTRAN +C +C HISTORY ORIGINALLY WRITTEN NOVEMBER 1976 +C +C ALGORITHM ROUTINE TVELVC CALLS ROUTINES EZVEC AND +C VELVCT ONCE. EACH CALL PRODUCES A PLOT +C REPRESENTING A VECTOR FIELD. THE VECTOR +C FIELD IS OBTAINED FROM THE FUNCTION +C Z(X,Y) = X + Y + 1./((X-.1)**2+Y**2+.09) +C -1./((X+.1)**2+Y**2+.09), +C BY USING THE DIRECTION OF THE Z GRADIENT +C VECTORS AND THE LOGARITHM OF THE ABSOLUTE +C VALUE OF THE COMPONENTS. +C +C +C +C + DIMENSION U(21,25) ,V(21,25) +C +C SPECIFY COORDS FOR PLOT TITLES +C + DATA IX/94/,IY/1000/ +C +C SPECIFY SOME OF THE ARGUMENTS IN VELVCT CALLING SEQUENCE +C + DATA FLO/0./,HI/0./,NSET/0/,LENGTH/0/,ISPV/0/,SPV/0./ +C +C INITIALIZE ERROR PARAMETER +C + IERROR = 1 +C +C SPECIFY VELOCITY FIELD FUNCTIONS U AND V +C + M = 21 + N = 25 + DO 20 I=1,M + X = .1*FLOAT(I-11) + DO 10 J=1,N + Y = .1*FLOAT(J-13) + DZDX = 1.-2.*(X-.10)/((X-.10)**2+Y**2+.09)**2+ + 1 2.*(X+.10)/((X+.10)**2+Y**2+.09)**2 + DZDY = 1.-2.*Y/((X-.10)**2+Y**2+.09)**2+ + 1 2.*Y/((X+.10)**2+Y**2+.09)**2 + UVMAG = ALOG(SQRT(DZDX*DZDX+DZDY*DZDY)) + UVDIR = ATAN2(DZDY,DZDX) + U(I,J) = UVMAG*COS(UVDIR) + V(I,J) = UVMAG*SIN(UVDIR) + 10 CONTINUE + 20 CONTINUE +C +C CALL WTSTR FOR EZVEC PLOT TITLE +C +c +noao: flag used to plot either velvct or ezvec + if (nplot .eq. 1) then + CALL GQCNTN(IERR,ICN) + CALL GSELNT(0) +c X = PAU2FX(IX) + x = cpux (ix) +c Y = PAU2FY(IY) + y = cpuy (iy) + CALL WTSTR (X,Y,'DEMONSTRATION PLOT FOR ENTRY EZVEC OF VELVCT', + 1 2,0,-1) + CALL GSELNT(ICN) +C +C CALL EZVEC FOR VELOCITY FIELD PLOT +C + CALL EZVEC (U,V,M,N) + endif +c -noao +C +C CALL VELVCT FOR VELOCITY FIELD PLOT +C +c +noao: flag used to plot either velvct or ezvec + if (nplot .eq. 2) then + CALL VELVCT (U,M,V,M,M,N,FLO,HI,NSET,LENGTH,ISPV,SPV) +C +C CALL WTSTR FOR VELVCT PLOT TITLE +C + CALL GQCNTN(IERR,ICN) + CALL GSELNT(0) +c X = PAU2FX(IX) + x = cpux (ix) +c Y = PAU2FY(IY) + y = cpuy (iy) + CALL WTSTR (X,Y, + 1 'DEMONSTRATION PLOT FOR ENTRY VELVCT OF VELVCT',2, + 2 0,-1) + CALL GSELNT(ICN) + endif +c -noao +c +c CALL NEWFM +C + IERROR = 0 +c WRITE (6,1001) + RETURN +C +c1001 FORMAT (' VELVCT TEST SUCCESSFUL',24X, +c 1 'SEE PLOTS TO VERIFY PERFORMANCE') +C + END diff --git a/sys/gio/ncarutil/tests/velvect.x b/sys/gio/ncarutil/tests/velvect.x new file mode 100644 index 00000000..d09f1c08 --- /dev/null +++ b/sys/gio/ncarutil/tests/velvect.x @@ -0,0 +1,32 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define DUMMY 6 + +include <error.h> +include <gset.h> + +# Test NCAR routines VELVEC + +procedure t_velvect() + +char device[SZ_FNAME] +int error_code, wkid +pointer gp, gopen() + +begin + call clgstr ("device", device, SZ_FNAME) + + call gopks (STDERR) + wkid = 1 + gp = gopen (device, NEW_FILE, STDGRAPH) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call tvelvc (2, error_code) + if (error_code == 0) + call printf ("Test successful\n") + + call gdawk (wkid) + call gclwk (wkid) + call gclks () +end diff --git a/sys/gio/ncarutil/tests/x_ncartest.x b/sys/gio/ncarutil/tests/x_ncartest.x new file mode 100644 index 00000000..cc8b727f --- /dev/null +++ b/sys/gio/ncarutil/tests/x_ncartest.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# These tasks temporarily deleted: conraq = t_conraq, conras = t_conras, + #ezmapg = t_ezmapg, + +task conran = t_conran, + autograph = t_autograph, + oldauto = t_oldauto, + dashsmth = t_dashsmth, + pwrzs = t_przs, + srface = t_surface, + ezsrface = t_ezsurface, + conrec = t_conrec, + ezconrec = t_ezconrec, + hafton = t_hafton, + isosrf = t_isosrf, + ezisosrf = t_ezisos, + ezhafton = t_ezhafton, + pwrity = t_pwrity, + threed = t_threed, + threed2 = t_threed2, + velvec = t_velvect, + ezvelvec = t_ezvelvect, + strmln = t_strmln |