From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/gio/ncarutil/tests/dashsmtht.f | 144 +++++++++++++++++++++++++++++++++++++ 1 file changed, 144 insertions(+) create mode 100644 sys/gio/ncarutil/tests/dashsmtht.f (limited to 'sys/gio/ncarutil/tests/dashsmtht.f') 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 -- cgit